[COMMITTED] ada: Fix internal error on address of element of packed array component

[Marc Poulhiès]

From: Eric Botcazou 

This occurs when the component is part of a discriminated type and its
offset depends on a discriminant, the problem being that the front-end
generates an incomplete Bit_Position attribute reference.

gcc/ada/

* exp_pakd.adb (Get_Base_And_Bit_Offset): Use the full component
reference instead of just the selector name for 'Bit_Position.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_pakd.adb | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index c3908a54538..ad12aec1e23 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -2112,8 +2112,8 @@ package body Exp_Pakd is
 
   --  We build up an expression serially that has the form
 
-  --linear-subscript * component_size   for each array reference
-  --  +  field'Bit_Position for each record field
+  --linear-subscript * component_size for each array component ref
+  --  +  pref.component'Bit_Position  for each record component ref
   --  +  ...
 
   loop
@@ -2135,7 +2135,7 @@ package body Exp_Pakd is
  elsif Nkind (Base) = N_Selected_Component then
 Term :=
   Make_Attribute_Reference (Loc,
-Prefix => Selector_Name (Base),
+Prefix => Base,
 Attribute_Name => Name_Bit_Position);
 
  else
-- 
2.42.0

[PATCH] testsuite: refine gcc.dg/analyzer/fd-4.c test for newlib

[Marc Poulhiès]

Contrary to glibc, including stdio.h from newlib defines mode_t which
conflicts with the test's type definition.

.../gcc/testsuite/gcc.dg/analyzer/fd-4.c:19:3: error: redefinition of typedef 
'mode_t' with different type
...
.../include/sys/types.h:189:25: note: previous declaration of 'mode_t' with 
type 'mode_t' {aka 'unsigned int'}

Defining _MODE_T_DECLARED skips the type definition.

gcc/testsuite/ChangeLog:

* gcc.dg/analyzer/fd-4.c: Fix for newlib.
---
Tested on x86_64-linux and x86_64-elf.

Ok for master?

 gcc/testsuite/gcc.dg/analyzer/fd-4.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/testsuite/gcc.dg/analyzer/fd-4.c 
b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
index 994bad84342..e4a834ade30 100644
--- a/gcc/testsuite/gcc.dg/analyzer/fd-4.c
+++ b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
@@ -1,3 +1,4 @@
+/* { dg-additional-options "-D_MODE_T_DECLARED=1" { target newlib } } */
 #ifdef _AIX
 #define _MODE_T
 #endif
-- 
2.42.0

[PATCH] testsuite: require avx_runtime for some tests

[Marc Poulhiès]

These 3 tests fails parsing the 'vect' dump when not using -mavx. Make
the dependency explicit.

gcc/testsuite/ChangeLog:

* gcc.dg/vect/vect-ifcvt-18.c: Add dep on avx_runtime.
* gcc.dg/vect/vect-simd-clone-16f.c: Likewise.
* gcc.dg/vect/vect-simd-clone-18f.c: Likewise.
---
Tested on x86_64-linux and x86_64-elf.

Ok for master?

 gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c   | 3 ++-
 gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c | 4 ++--
 gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c | 4 ++--
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c 
b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
index c1d3c27d819..607194496e9 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
@@ -1,6 +1,7 @@
 /* { dg-require-effective-target vect_condition } */
 /* { dg-require-effective-target vect_float } */
-/* { dg-additional-options "-Ofast -mavx" { target avx_runtime } } */
+/* { dg-require-effective-target avx_runtime } */
+/* { dg-additional-options "-Ofast -mavx" } */
 
 
 int A0[4] = {36,39,42,45};
diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c 
b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
index 7cd29e894d0..c6615dc626d 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
@@ -1,6 +1,6 @@
 /* { dg-require-effective-target vect_simd_clones } */
-/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" } */
-/* { dg-additional-options "-mavx" { target avx_runtime } } */
+/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0 
-mavx" } */
+/* { dg-require-effective-target avx_runtime } */
 /* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-* } 
&& { ! lp64 } } } } */
 
 #define TYPE __INT64_TYPE__
diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c 
b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
index 4dd51381d73..787b918d0c4 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
@@ -1,6 +1,6 @@
 /* { dg-require-effective-target vect_simd_clones } */
-/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" } */
-/* { dg-additional-options "-mavx" { target avx_runtime } } */
+/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0 
-mavx" } */
+/* { dg-require-effective-target  avx_runtime } */
 /* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-* } 
&& { ! lp64 } } } } */
 
 #define TYPE __INT64_TYPE__
-- 
2.42.0

[PATCH] testsuite: skip gcc.target/i386/pr106910-1.c test when using newlib

[Marc Poulhiès]

Using newlib produces a different codegen because the support for c99
differs (see libc_has_function hook).

gcc/testsuite/ChangeLog:

* gcc.target/i386/pr106910-1.c: Disable for newlib.
---
Tested on x86_64-linux and x86_64-elf.

OK for master?

 gcc/testsuite/gcc.target/i386/pr106910-1.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gcc/testsuite/gcc.target/i386/pr106910-1.c 
b/gcc/testsuite/gcc.target/i386/pr106910-1.c
index c7685a32183..00c93f444b6 100644
--- a/gcc/testsuite/gcc.target/i386/pr106910-1.c
+++ b/gcc/testsuite/gcc.target/i386/pr106910-1.c
@@ -1,4 +1,6 @@
+
 /* { dg-do compile { target { ! ia32 } } } */
+/* { dg-skip-if "newlib libc math causes different codegen" { newlib } } */
 /* { dg-options "-msse4.1 -O2 -Ofast" } */
 /* { dg-final { scan-assembler-times "roundps" 9 } } */
 /* { dg-final { scan-assembler-times "cvtps2dq" 1 } } */
-- 
2.42.0

[COMMITTED] ada: Refactor code to remove GNATcheck violation

[Marc Poulhiès]

From: Sheri Bernstein 

Rewrite for loop containing an exit (which violates GNATcheck
rule Exits_From_Conditional_Loops), to use a while loop
which contains the exit criteria in its condition.
Also, move special case of first time through loop, to come
before loop.

gcc/ada/

* libgnat/s-imagef.adb (Set_Image_Fixed): Refactor loop.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-imagef.adb | 75 +++-
 1 file changed, 40 insertions(+), 35 deletions(-)

diff --git a/gcc/ada/libgnat/s-imagef.adb b/gcc/ada/libgnat/s-imagef.adb
index 3f6bfa20cb2..6194a3163de 100644
--- a/gcc/ada/libgnat/s-imagef.adb
+++ b/gcc/ada/libgnat/s-imagef.adb
@@ -307,6 +307,9 @@ package body System.Image_F is
   YY : Int := Y;
   --  First two operands of the scaled divide
 
+  J : Natural;
+  --  Loop index
+
begin
   --  Set the first character like Image
 
@@ -317,59 +320,61 @@ package body System.Image_F is
  Ndigs := 0;
   end if;
 
-  for J in 1 .. N loop
- exit when XX = 0;
+  --  First round of scaled divide
 
+  if XX /= 0 then
  Scaled_Divide (XX, YY, Z, Q, R => XX, Round => False);
+ if Q /= 0 then
+Set_Image_Integer (Q, Digs, Ndigs);
+ end if;
 
- if J = 1 then
-if Q /= 0 then
-   Set_Image_Integer (Q, Digs, Ndigs);
-end if;
-
-Scale := Scale + D;
+ Scale := Scale + D;
 
---  Prepare for next round, if any
+ --  Prepare for next round, if any
 
-YY := 10**Maxdigs;
+ YY := 10**Maxdigs;
+  end if;
 
- else
-pragma Assert (-10**Maxdigs < Q and then Q < 10**Maxdigs);
+  J := 2;
+  while J <= N and then XX /= 0 loop
+ Scaled_Divide (XX, YY, Z, Q, R => XX, Round => False);
 
-Len := 0;
-Set_Image_Integer (abs Q, Buf, Len);
+ pragma Assert (-10**Maxdigs < Q and then Q < 10**Maxdigs);
 
-pragma Assert (1 <= Len and then Len <= Maxdigs);
+ Len := 0;
+ Set_Image_Integer (abs Q, Buf, Len);
 
---  If no character but the space has been written, write the
---  minus if need be, since Set_Image_Integer did not do it.
+ pragma Assert (1 <= Len and then Len <= Maxdigs);
 
-if Ndigs <= 1 then
-   if Q /= 0 then
-  if Ndigs = 0 then
- Digs (1) := '-';
-  end if;
+ --  If no character but the space has been written, write the
+ --  minus if need be, since Set_Image_Integer did not do it.
 
-  Digs (2 .. Len + 1) := Buf (1 .. Len);
-  Ndigs := Len + 1;
+ if Ndigs <= 1 then
+if Q /= 0 then
+   if Ndigs = 0 then
+  Digs (1) := '-';
end if;
 
---  Or else pad the output with zeroes up to Maxdigs
+   Digs (2 .. Len + 1) := Buf (1 .. Len);
+   Ndigs := Len + 1;
+end if;
 
-else
-   for K in 1 .. Maxdigs - Len loop
-  Digs (Ndigs + K) := '0';
-   end loop;
+ --  Or else pad the output with zeroes up to Maxdigs
 
-   for K in 1 .. Len loop
-  Digs (Ndigs + Maxdigs - Len + K) := Buf (K);
-   end loop;
+ else
+for K in 1 .. Maxdigs - Len loop
+   Digs (Ndigs + K) := '0';
+end loop;
 
-   Ndigs := Ndigs + Maxdigs;
-end if;
+for K in 1 .. Len loop
+   Digs (Ndigs + Maxdigs - Len + K) := Buf (K);
+end loop;
 
-Scale := Scale + Maxdigs;
+Ndigs := Ndigs + Maxdigs;
  end if;
+
+ Scale := Scale + Maxdigs;
+ J := J + 1;
   end loop;
 
   --  If no digit was output, this is zero
-- 
2.42.0

[COMMITTED] ada: Add pragma Annotate for GNATcheck exemptions

[Marc Poulhiès]

From: Sheri Bernstein 

Exempt the GNATcheck rule "Unassigned_OUT_Parameters"
with the rationale "the OUT parameter is assigned by component".

gcc/ada/

* libgnat/s-imguti.adb (Set_Decimal_Digits): Add pragma to exempt
Unassigned_OUT_Parameters.
(Set_Floating_Invalid_Value): Likewise

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-imguti.adb | 8 
 1 file changed, 8 insertions(+)

diff --git a/gcc/ada/libgnat/s-imguti.adb b/gcc/ada/libgnat/s-imguti.adb
index 4b9e27a7d8f..cb081108950 100644
--- a/gcc/ada/libgnat/s-imguti.adb
+++ b/gcc/ada/libgnat/s-imguti.adb
@@ -37,6 +37,8 @@ package body System.Img_Util is
-- Set_Decimal_Digits --

 
+   pragma Annotate (Gnatcheck, Exempt_On, "Unassigned_OUT_Parameters",
+"the OUT parameter is assigned by component");
procedure Set_Decimal_Digits
  (Digs  : in out String;
   NDigs : Natural;
@@ -47,6 +49,8 @@ package body System.Img_Util is
   Aft   : Natural;
   Exp   : Natural)
is
+  pragma Annotate (Gnatcheck, Exempt_Off, "Unassigned_OUT_Parameters");
+
   pragma Assert (NDigs >= 1);
   pragma Assert (Digs'First = 1);
   pragma Assert (Digs'First < Digs'Last);
@@ -413,6 +417,8 @@ package body System.Img_Util is
-- Set_Floating_Invalid_Value --

 
+   pragma Annotate (Gnatcheck, Exempt_On, "Unassigned_OUT_Parameters",
+"the OUT parameter is assigned by component");
procedure Set_Floating_Invalid_Value
  (V: Floating_Invalid_Value;
   S: out String;
@@ -421,6 +427,8 @@ package body System.Img_Util is
   Aft  : Natural;
   Exp  : Natural)
is
+  pragma Annotate (Gnatcheck, Exempt_Off, "Unassigned_OUT_Parameters");
+
   procedure Set (C : Character);
   --  Sets character C in output buffer
 
-- 
2.42.0

[COMMITTED] ada: Document gnatbind -Q switch

[Marc Poulhiès]

From: Patrick Bernardi 

Add documentation for the -Q gnatbind switch in GNAT User's Guide and
improve gnatbind's help output for the switch to emphasize that it adds the
requested number of stacks to the secondary stack pool generated by the
binder.

gcc/ada/

* bindusg.adb (Display): Make it clear -Q adds to the number of
secondary stacks generated by the binder.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Document the -Q gnatbind switch and fix references to old
runtimes.
* gnat-style.texi: Regenerate.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/bindusg.adb   |  2 +-
 ...building_executable_programs_with_gnat.rst | 29 ++---
 gcc/ada/gnat-style.texi   |  4 +-
 gcc/ada/gnat_rm.texi  |  4 +-
 gcc/ada/gnat_ugn.texi | 41 ++-
 5 files changed, 59 insertions(+), 21 deletions(-)

diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb
index fca425b2244..89a6caedf31 100644
--- a/gcc/ada/bindusg.adb
+++ b/gcc/ada/bindusg.adb
@@ -234,7 +234,7 @@ package body Bindusg is
   --  Line for Q switch
 
   Write_Line
-("  -Qnnn Generate nnn default-sized secondary stacks");
+("  -Qnnn Generate nnn additional default-sized secondary stacks");
 
   --  Line for -r switch
 
diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst 
b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 6e80163d6d4..a708ef4b995 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -6524,12 +6524,12 @@ be presented in subsequent sections.
   determines the initial size of the secondary stack for each task and the
   smallest amount the secondary stack can grow by.
 
-  For Ravenscar, ZFP, and Cert run-times the size of the secondary stack is
-  fixed. This switch can be used to change the default size of these stacks.
-  The default secondary stack size can be overridden on a per-task basis if
-  individual tasks have different secondary stack requirements. This is
-  achieved through the Secondary_Stack_Size aspect that takes the size of the
-  secondary stack in bytes.
+  For Light, Light-Tasking, and Embedded run-times the size of the secondary
+  stack is fixed. This switch can be used to change the default size of these
+  stacks. The default secondary stack size can be overridden on a per-task
+  basis if individual tasks have different secondary stack requirements. This
+  is achieved through the Secondary_Stack_Size aspect, which takes the size of
+  the secondary stack in bytes.
 
 .. index:: -e  (gnatbind)
 
@@ -6739,6 +6739,23 @@ be presented in subsequent sections.
   Generate binder file suitable for CodePeer.
 
 
+.. index:: -Q  (gnatbind)
+
+:switch:`-Q{nnn}`
+  Generate ``nnn`` additional default-sized secondary stacks.
+
+  Tasks declared at the library level that use default-size secondary stacks
+  have their secondary stacks allocated from a pool of stacks generated by
+  gnatbind. This allows the default secondary stack size to be quickly changed
+  by rebinding the application.
+
+  While the binder sizes this pool to match the number of such tasks defined in
+  the application, the pool size may need to be increased with the :switch:`-Q`
+  switch to accommodate foreign threads registered with the Light run-time. For
+  more information, please see the *The Primary and Secondary Stack* chapter in
+  the *GNAT User’s Guide Supplement for Cross Platforms*.
+
+
   .. index:: -R  (gnatbind)
 
 :switch:`-R`
diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi
index bcdc160..33bb1886985 100644
--- a/gcc/ada/gnat-style.texi
+++ b/gcc/ada/gnat-style.texi
@@ -3,7 +3,7 @@
 @setfilename gnat-style.info
 @documentencoding UTF-8
 @ifinfo
-@*Generated by Sphinx 5.2.3.@*
+@*Generated by Sphinx 7.2.6.@*
 @end ifinfo
 @settitle GNAT Coding Style A Guide for GNAT Developers
 @defindex ge
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT Coding Style: A Guide for GNAT Developers , May 09, 2023
+GNAT Coding Style: A Guide for GNAT Developers , Oct 16, 2023
 
 AdaCore
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index b7e098331e9..9a6a0170ae8 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -3,7 +3,7 @@
 @setfilename gnat_rm.info
 @documentencoding UTF-8
 @ifinfo
-@*Generated by Sphinx 5.2.3.@*
+@*Generated by Sphinx 7.2.6.@*
 @end ifinfo
 @settitle GNAT Reference Manual
 @defindex ge
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Jul 17, 2023
+GNAT Reference Manual , Oct 16, 2023
 
 AdaCore
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 1562bee1f64..897153bcfc7 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -

[COMMITTED] ada: Seize opportunity to reuse List_Length

[Marc Poulhiès]

From: Ronan Desplanques 

This patch is intended as a readability improvement. It doesn't
change the behavior of the compiler.

gcc/ada/

* sem_ch3.adb (Constrain_Array): Replace manual list length
computation by call to List_Length.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 8 +---
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c79d323395f..e92b46fa6f6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13809,7 +13809,7 @@ package body Sem_Ch3 is
   Suffix  : Character)
is
   C : constant Node_Id := Constraint (SI);
-  Number_Of_Constraints : Nat := 0;
+  Number_Of_Constraints : constant Nat := List_Length (Constraints (C));
   Index : Node_Id;
   S, T  : Entity_Id;
   Constraint_OK : Boolean := True;
@@ -13835,12 +13835,6 @@ package body Sem_Ch3 is
  Constraint_OK := False;
 
   else
- S := First (Constraints (C));
- while Present (S) loop
-Number_Of_Constraints := Number_Of_Constraints + 1;
-Next (S);
- end loop;
-
  --  In either case, the index constraint must provide a discrete
  --  range for each index of the array type and the type of each
  --  discrete range must be the same as that of the corresponding
-- 
2.42.0

[COMMITTED] ada: Simplify "not Present" with "No"

[Marc Poulhiès]

From: Piotr Trojanek 

gcc/ada/

* exp_aggr.adb (Expand_Container_Aggregate): Simplify with "No".

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index e5f36326600..340c8c68465 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7288,7 +7288,7 @@ package body Exp_Aggr is
  --  Iterated component association. Discard
  --  positional insertion procedure.
 
- if not Present (Iterator_Specification (Comp)) then
+ if No (Iterator_Specification (Comp)) then
 Add_Named_Subp := Assign_Indexed_Subp;
 Add_Unnamed_Subp := Empty;
  end if;
-- 
2.42.0

[COMMITTED] ada: Fix filesystem entry filtering

[Marc Poulhiès]

From: Ronan Desplanques 

This patch fixes the behavior of Ada.Directories.Search when being
requested to filter out regular files or directories. One of the
configurations in which that behavior was incorrect was that when the
caller requested only the regular and special files but not the
directories, the directories would still be returned.

gcc/ada/

* libgnat/a-direct.adb: Fix filesystem entry filtering.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/a-direct.adb | 30 --
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb
index 4b08d41337d..f7a1d5dfd6d 100644
--- a/gcc/ada/libgnat/a-direct.adb
+++ b/gcc/ada/libgnat/a-direct.adb
@@ -1414,24 +1414,26 @@ package body Ada.Directories is
 
   elsif Exists = 1 then
  if Is_Regular_File_Attr (Path_C'Address, Attr'Access) = 1
-   and then Filter (Ordinary_File)
  then
-Found := True;
-Kind := Ordinary_File;
-Size :=
-  File_Size
-(File_Length_Attr
-   (-1, Path_C'Address, Attr'Access));
+if Filter (Ordinary_File) then
+   Found := True;
+   Kind := Ordinary_File;
+   Size :=
+ File_Size
+   (File_Length_Attr
+  (-1, Path_C'Address, Attr'Access));
 
+end if;
  elsif Is_Directory_Attr (Path_C'Address, Attr'Access) = 1
-   and then Filter (File_Kind'First)
  then
-Found := True;
-Kind := File_Kind'First;
---  File_Kind'First is used instead of Directory due
---  to a name overload issue with the procedure
---  parameter Directory.
-Size := 0;
+if Filter (File_Kind'First) then
+   Found := True;
+   Kind := File_Kind'First;
+   --  File_Kind'First is used instead of Directory due
+   --  to a name overload issue with the procedure
+   --  parameter Directory.
+   Size := 0;
+end if;
 
  elsif Filter (Special_File) then
 Found := True;
-- 
2.42.0

[COMMITTED] ada: Fix internal error on too large representation clause for small component

[Marc Poulhiès]

From: Eric Botcazou 

This is a small bug present on strict-alignment platforms for questionable
representation clauses.

gcc/ada/

* gcc-interface/decl.cc (inline_status_for_subprog): Minor tweak.
(gnat_to_gnu_field): Try harder to get a packable form of the type
for a bitfield.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/decl.cc | 14 +-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 5e16b56217c..20ab185d577 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -5114,7 +5114,7 @@ inline_status_for_subprog (Entity_Id subprog)
   tree gnu_type;
 
   /* This is a kludge to work around a pass ordering issue: for small
-record types with many components, i.e. typically bit-fields, the
+record types with many components, i.e. typically bitfields, the
 initialization routine can contain many assignments that will be
 merged by the GIMPLE store merging pass.  But this pass runs very
 late in the pipeline, in particular after the inlining decisions
@@ -7702,6 +7702,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree 
gnu_record_type, int packed,
   gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
   false, definition, true);
 
+  /* For a bitfield, if the type still has BLKmode, try again to change it
+to an integral mode form.  This may be necessary on strict-alignment
+platforms with a size clause that is much larger than the field type,
+because maybe_pad_type has preserved the alignment of the field type,
+which may be too low for the new size.  */
+  if (!needs_strict_alignment
+ && RECORD_OR_UNION_TYPE_P (gnu_field_type)
+ && !TYPE_FAT_POINTER_P (gnu_field_type)
+ && TYPE_MODE (gnu_field_type) == BLKmode
+ && is_bitfield)
+   gnu_field_type = make_packable_type (gnu_field_type, true, 1);
+
   /* If a padding record was made, declare it now since it will never be
 declared otherwise.  This is necessary to ensure that its subtrees
 are properly marked.  */
-- 
2.42.0

[COMMITTED] ada: Fix infinite loop with multiple limited with clauses

[Marc Poulhiès]

From: Eric Botcazou 

This occurs when one of the types has an incomplete declaration in addition
to its full declaration in its package. In this case AI05-129 says that the
incomplete type is not part of the limited view of the package, i.e. only
the full view is. Now, in the GNAT implementation, it's the opposite in the
regular view of the package, i.e. the incomplete type is the visible one.

That's why the implementation needs to also swap the types on the visibility
chain while it is swapping the views when the clauses are either installed
or removed. This works correctly for the installation, but does not for the
removal, so this change rewrites the code doing the latter.

gcc/ada/
PR ada/111434
* sem_ch10.adb (Replace): New procedure to replace an entity with
another on the homonym chain.
(Install_Limited_With_Clause): Rename Non_Lim_View to Typ for the
sake of consistency.  Call Replace to do the replacements and split
the code into the regular and the special cases.  Add debuggging
output controlled by -gnatdi.
(Install_With_Clause): Print the Parent_With and Implicit_With flags
in the debugging output controlled by -gnatdi.
(Remove_Limited_With_Unit.Restore_Chain_For_Shadow (Shadow)): Rewrite
using a direct replacement of E4 by E2.   Call Replace to do the
replacements.  Add debuggging output controlled by -gnatdi.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch10.adb | 170 +++
 1 file changed, 107 insertions(+), 63 deletions(-)

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index a6cbe466b75..ba4beae2851 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -238,6 +238,9 @@ package body Sem_Ch10 is
--  Reset all visibility flags on unit after compiling it, either as a main
--  unit or as a unit in the context.
 
+   procedure Replace (Old_E, New_E : Entity_Id);
+   --  Replace Old_E by New_E on visibility list
+
procedure Unchain (E : Entity_Id);
--  Remove single entity from visibility list
 
@@ -5310,15 +5313,12 @@ package body Sem_Ch10 is
   and then not Is_Child_Unit (Lim_Typ)
 then
declare
-  Non_Lim_View : constant Entity_Id :=
-   Non_Limited_View (Lim_Typ);
+  Typ : constant Entity_Id := Non_Limited_View (Lim_Typ);
 
   Prev : Entity_Id;
 
begin
-  Prev := Current_Entity (Lim_Typ);
-
-  --  Replace Non_Lim_View in the homonyms list, so that the
+  --  Replace Typ by Lim_Typ in the homonyms list, so that the
   --  limited view becomes available.
 
   --  If the nonlimited view is a record with an anonymous
@@ -5350,38 +5350,47 @@ package body Sem_Ch10 is
   --
   --  [*] denotes the visible entity (Current_Entity)
 
-  if Prev = Non_Lim_View
-or else
-  (Ekind (Prev) = E_Incomplete_Type
-and then Full_View (Prev) = Non_Lim_View)
-or else
-  (Ekind (Prev) = E_Incomplete_Type
-and then From_Limited_With (Prev)
-and then
-  Ekind (Non_Limited_View (Prev)) = E_Incomplete_Type
-and then
-  Full_View (Non_Limited_View (Prev)) = Non_Lim_View)
-  then
- Set_Current_Entity (Lim_Typ);
+  Prev := Current_Entity (Lim_Typ);
 
-  else
- while Present (Homonym (Prev))
-   and then Homonym (Prev) /= Non_Lim_View
- loop
-Prev := Homonym (Prev);
- end loop;
+  while Present (Prev) loop
+ --  This is a regular replacement
 
- Set_Homonym (Prev, Lim_Typ);
-  end if;
+ if Prev = Typ
+   or else (Ekind (Prev) = E_Incomplete_Type
+ and then Full_View (Prev) = Typ)
+ then
+Replace (Prev, Lim_Typ);
 
-  Set_Homonym (Lim_Typ, Homonym (Non_Lim_View));
-   end;
+if Debug_Flag_I then
+   Write_Str ("   (homonym) replace ");
+   Write_Name (Chars (Typ));
+   Write_Eol;
+end if;
 
-   if Debug_Flag_I then
-  Write_Str ("   (homonym) chain ");
-  Write_Name (Chars (Lim_Typ));
-  Write_Eol;
-   end if;
+exit;
+
+ --  This is where E1 

[COMMITTED] ada: Tweak internal subprogram in Ada.Directories

[Marc Poulhiès]

From: Ronan Desplanques 

The purpose of this patch is to work around false-positive warnings
emitted by GNAT SAS (also known as CodePeer). It does not change
the behavior of the modified subprogram.

gcc/ada/

* libgnat/a-direct.adb (Start_Search_Internal): Tweak subprogram
body.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/a-direct.adb | 46 
 1 file changed, 25 insertions(+), 21 deletions(-)

diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb
index f7a1d5dfd6d..594971c6021 100644
--- a/gcc/ada/libgnat/a-direct.adb
+++ b/gcc/ada/libgnat/a-direct.adb
@@ -1379,13 +1379,21 @@ package body Ada.Directories is
  Compose (Directory, File_Name) & ASCII.NUL;
   Path   : String renames
  Path_C (Path_C'First .. Path_C'Last - 1);
-  Found  : Boolean := False;
   Attr   : aliased File_Attributes;
   Exists : Integer;
   Error  : Integer;
-  Kind   : File_Kind;
-  Size   : File_Size;
 
+  type Result (Found : Boolean := False) is record
+ case Found is
+when True =>
+   Kind : File_Kind;
+   Size : File_Size;
+when False =>
+   null;
+ end case;
+  end record;
+
+  Res : Result := (Found => False);
begin
   --  Get the file attributes for the directory item
 
@@ -1416,32 +1424,28 @@ package body Ada.Directories is
  if Is_Regular_File_Attr (Path_C'Address, Attr'Access) = 1
  then
 if Filter (Ordinary_File) then
-   Found := True;
-   Kind := Ordinary_File;
-   Size :=
- File_Size
-   (File_Length_Attr
-  (-1, Path_C'Address, Attr'Access));
+   Res := (Found => True,
+   Kind => Ordinary_File,
+   Size => File_Size
+ (File_Length_Attr
+(-1, Path_C'Address, Attr'Access)));
 
 end if;
  elsif Is_Directory_Attr (Path_C'Address, Attr'Access) = 1
  then
 if Filter (File_Kind'First) then
-   Found := True;
-   Kind := File_Kind'First;
-   --  File_Kind'First is used instead of Directory due
-   --  to a name overload issue with the procedure
-   --  parameter Directory.
-   Size := 0;
+   Res := (Found => True,
+   Kind => File_Kind'First,
+   Size => 0);
 end if;
 
  elsif Filter (Special_File) then
-Found := True;
-Kind := Special_File;
-Size := 0;
+Res := (Found => True,
+Kind => Special_File,
+Size => 0);
  end if;
 
- if Found then
+ if Res.Found then
 Search.State.Dir_Contents.Append
   (Directory_Entry_Type'
  (Valid => True,
@@ -1449,9 +1453,9 @@ package body Ada.Directories is
 To_Unbounded_String (File_Name),
   Full_Name => To_Unbounded_String (Path),
   Attr_Error_Code   => 0,
-  Kind  => Kind,
+  Kind  => Res.Kind,
   Modification_Time => Modification_Time (Path),
-  Size  => Size));
+  Size  => Res.Size));
  end if;
   end if;
end;
-- 
2.42.0

[COMMITTED] ada: Remove superfluous setter procedure

[Marc Poulhiès]

From: Eric Botcazou 

It is only called once.

gcc/ada/

* sem_util.ads (Set_Scope_Is_Transient): Delete.
* sem_util.adb (Set_Scope_Is_Transient): Likewise.
* exp_ch7.adb (Create_Transient_Scope): Set Is_Transient directly.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch7.adb  | 2 +-
 gcc/ada/sem_util.adb | 9 -
 gcc/ada/sem_util.ads | 3 ---
 3 files changed, 1 insertion(+), 13 deletions(-)

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 5049de54dd7..00b7692c964 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4529,7 +4529,7 @@ package body Exp_Ch7 is
 
  Push_Scope (Trans_Scop);
  Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped := Context;
- Set_Scope_Is_Transient;
+ Scope_Stack.Table (Scope_Stack.Last).Is_Transient := True;
 
  --  The transient scope must also manage the secondary stack
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e778bab95d1..26ddb52bc4a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -27792,15 +27792,6 @@ package body Sem_Util is
   end if;
end Set_Rep_Info;
 
-   
-   -- Set_Scope_Is_Transient --
-   
-
-   procedure Set_Scope_Is_Transient (V : Boolean := True) is
-   begin
-  Scope_Stack.Table (Scope_Stack.Last).Is_Transient := V;
-   end Set_Scope_Is_Transient;
-
---
-- Set_Size_Info --
---
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 92016bc0eef..dda71e402b2 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -3165,9 +3165,6 @@ package Sem_Util is
--  from sub(type) entity T2 to (sub)type entity T1, as well as Is_Volatile
--  if T1 is a base type.
 
-   procedure Set_Scope_Is_Transient (V : Boolean := True);
-   --  Set the flag Is_Transient of the current scope
-
procedure Set_Size_Info (T1, T2 : Entity_Id);
pragma Inline (Set_Size_Info);
--  Copies the Esize field and Has_Biased_Representation flag from sub(type)
-- 
2.42.0

[COMMITTED] ada: Fix bad finalization of limited aggregate in conditional expression

[Marc Poulhiès]

From: Eric Botcazou 

This happens when the conditional expression is immediately returned, for
example in an expression function.

gcc/ada/

* exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): Return true
if the aggregate is a dependent expression of a conditional
expression being returned from a build-in-place function.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 13 ++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 165f517c031..e5f36326600 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -173,8 +173,11 @@ package body Exp_Aggr is
--
 
function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean;
-   --  True if N is an aggregate (possibly qualified or converted) that is
-   --  being returned from a build-in-place function.
+   --  True if N is an aggregate (possibly qualified or a dependent expression
+   --  of a conditional expression, and possibly recursively so) that is being
+   --  returned from a build-in-place function. Such qualified and conditional
+   --  expressions are transparent for this purpose because an enclosing return
+   --  is propagated resp. distributed into these expressions by the expander.
 
function Build_Record_Aggr_Code
  (N   : Node_Id;
@@ -8463,7 +8466,11 @@ package body Exp_Aggr is
   P : Node_Id := Parent (N);
 
begin
-  while Nkind (P) = N_Qualified_Expression loop
+  while Nkind (P) in N_Case_Expression
+   | N_Case_Expression_Alternative
+   | N_If_Expression
+   | N_Qualified_Expression
+  loop
  P := Parent (P);
   end loop;
 
-- 
2.42.0

[COMMITTED] ada: Tweak documentation comments

[Marc Poulhiès]

From: Ronan Desplanques 

The concept of extended nodes was retired at the same time Gen_IL
was introduced, but there was a reference to that concept left over
in a comment. This patch removes that reference.

Also, the description of the field Comes_From_Check_Or_Contract was
incorrectly placed in a section for fields present in all nodes in
sinfo.ads. This patch fixes this.

gcc/ada/

* atree.ads, nlists.ads, types.ads: Remove references to extended
nodes. Fix typo.
* sinfo.ads: Likewise and fix position of
Comes_From_Check_Or_Contract description.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/atree.ads  |  9 -
 gcc/ada/nlists.ads |  3 ---
 gcc/ada/sinfo.ads  | 31 ++-
 gcc/ada/types.ads  |  4 +---
 4 files changed, 11 insertions(+), 36 deletions(-)

diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index abe5cc5f3b5..2ff65d24679 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -252,7 +252,7 @@ package Atree is
--  The usual approach is to build a new node using this function and
--  then, using the value returned, use the Set_xxx functions to set
--  fields of the node as required. New_Node can only be used for
-   --  non-entity nodes, i.e. it never generates an extended node.
+   --  non-entity nodes.
--
--  If we are currently parsing, as indicated by a previous call to
--  Set_Comes_From_Source_Default (True), then this call also resets
@@ -308,8 +308,7 @@ package Atree is
--  returns Empty, and New_Copy (Error) returns Error. Note that, unlike
--  Copy_Separate_Tree, New_Copy does not recursively copy any descendants,
--  so in general parent pointers are not set correctly for the descendants
-   --  of the copied node. Both normal and extended nodes (entities) may be
-   --  copied using New_Copy.
+   --  of the copied node.
 
function Relocate_Node (Source : Node_Id) return Node_Id;
--  Source is a non-entity node that is to be relocated. A new node is
@@ -359,7 +358,7 @@ package Atree is
--  caller, according to context.
 
procedure Extend_Node (Source : Node_Id);
-   --  This turns a node into an entity; it function is used only by Sinfo.CN.
+   --  This turns a node into an entity; it is only used by Sinfo.CN.
 
type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id);
 
@@ -540,7 +539,7 @@ package Atree is
--  newly constructed replacement subtree. The actual mechanism is to swap
--  the contents of these two nodes fixing up the parent pointers of the
--  replaced node (we do not attempt to preserve parent pointers for the
-   --  original node). Neither Old_Node nor New_Node can be extended nodes.
+   --  original node).
--  ??? The above explanation is incorrect, instead Copy_Node is called.
--
--  Note: New_Node may not contain references to Old_Node, for example as
diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads
index 5e88032ff7d..7afe80f0051 100644
--- a/gcc/ada/nlists.ads
+++ b/gcc/ada/nlists.ads
@@ -43,9 +43,6 @@ package Nlists is
--  this header, which may be used to access the nodes in the list using
--  the set of routines that define this interface.
 
-   --  Note: node lists can contain either nodes or entities (extended nodes)
-   --  or a mixture of nodes and extended nodes.
-
function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean;
pragma Inline (In_Same_List);
--  Equivalent to List_Containing (N1) = List_Containing (N2)
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 57fd704475c..fc9bcfbd44d 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -82,12 +82,6 @@ package Sinfo is
-- for this purpose, so e.g. in X := (if A then B else C);
-- Paren_Count for the right side will be 1.
 
-   --   Comes_From_Check_Or_Contract
-   -- This flag is present in all N_If_Statement nodes and
-   -- gets set when an N_If_Statement is generated as part of
-   -- the expansion of a Check, Assert, or contract-related
-   -- pragma.
-
--   Comes_From_Source
-- This flag is present in all nodes. It is set if the
-- node is built by the scanner or parser, and clear if
@@ -953,6 +947,12 @@ package Sinfo is
--attribute definition clause is given, rather than testing this at the
--freeze point.
 
+   --  Comes_From_Check_Or_Contract
+   --This flag is present in all N_If_Statement nodes and
+   --gets set when an N_If_Statement is generated as part of
+   --the expansion of a Check, Assert, or contract-related
+   --pragma.
+
--  Comes_From_Extended_Return_Statement
--Present in N_Simple_Return_Statement nodes. True if this node was
--constructed as part of the N_Extended_Return_Statement expansion.
@@ -2809,12 +2809,6 @@ package Sinfo is
   --  fields are defi

[COMMITTED] ada: Crash processing pragmas Compile_Time_Error and Compile_Time_Warning

[Marc Poulhiès]

From: Javier Miranda 

gcc/ada/

* sem_attr.adb (Analyze_Attribute): Protect the frontend against
replacing 'Size by its static value if 'Size is not known at
compile time and we are processing pragmas Compile_Time_Warning or
Compile_Time_Errors.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_attr.adb | 25 +++--
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d03761b1e30..3eba3a29362 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6457,17 +6457,30 @@ package body Sem_Attr is
or else Size_Known_At_Compile_Time (Entity (P)))
  then
 declare
-   Siz : Uint;
+   Prefix_E : Entity_Id := Entity (P);
+   Siz  : Uint;
 
 begin
-   if Known_Static_RM_Size (Entity (P)) then
-  Siz := RM_Size (Entity (P));
+   --  Handle private and incomplete types
+
+   if Present (Underlying_Type (Prefix_E)) then
+  Prefix_E := Underlying_Type (Prefix_E);
+   end if;
+
+   if Known_Static_RM_Size (Prefix_E) then
+  Siz := RM_Size (Prefix_E);
else
-  Siz := Esize (Entity (P));
+  Siz := Esize (Prefix_E);
end if;
 
-   Rewrite (N, Make_Integer_Literal (Sloc (N), Siz));
-   Analyze (N);
+   --  Protect the frontend against cases where the attribute
+   --  Size_Known_At_Compile_Time is set, but the Esize value
+   --  is not available (see Einfo.ads).
+
+   if Present (Siz) then
+  Rewrite (N, Make_Integer_Literal (Sloc (N), Siz));
+  Analyze (N);
+   end if;
 end;
  end if;
 
-- 
2.42.0

[COMMITTED] ada: Fix unnesting generated loops with nested finalization procedure

[Marc Poulhiès]

The compiler can generate loops for creating array aggregates, for
example used during the initialization of variable. If the component
type of the array element requires finalization, the compiler also
creates a block and a nested procedure that need to be correctly
unnested if unnesting is enabled. During the unnesting transformation,
the scopes for these inner blocks need to be fixed and set to the
enclosing loop entity.

gcc/ada/

* exp_ch7.adb (Contains_Subprogram): Recursively search for subp
in loop's statements.
(Unnest_Loop): New.
(Unnest_Loop): Rename local variable for more clarity.
* exp_unst.ads: Refresh comment.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch7.adb  | 88 +---
 gcc/ada/exp_unst.ads |  7 +---
 2 files changed, 85 insertions(+), 10 deletions(-)

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 271dfd22618..585acd8b428 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4378,6 +4378,32 @@ package body Exp_Ch7 is
begin
   E := First_Entity (Blk);
 
+  --  The compiler may generate loops with a declare block containing
+  --  nested procedures used for finalization. Recursively search for
+  --  subprograms in such constructs.
+
+  if Ekind (Blk) = E_Loop
+and then Parent_Kind (Blk) = N_Loop_Statement
+  then
+ declare
+Stmt : Node_Id := First (Statements (Parent (Blk)));
+ begin
+while Present (Stmt) loop
+   if Nkind (Stmt) = N_Block_Statement then
+  declare
+ Id : constant Entity_Id :=
+  Entity (Identifier (Stmt));
+  begin
+ if Contains_Subprogram (Id) then
+return True;
+ end if;
+  end;
+   end if;
+   Next (Stmt);
+end loop;
+ end;
+  end if;
+
   while Present (E) loop
  if Is_Subprogram (E) then
 return True;
@@ -9350,17 +9376,67 @@ package body Exp_Ch7 is
-
 
procedure Unnest_Loop (Loop_Stmt : Node_Id) is
+
+  procedure Fixup_Inner_Scopes (Loop_Stmt : Node_Id);
+  --  The loops created by the compiler for array aggregates can have
+  --  nested finalization procedure when the type of the array components
+  --  needs finalization. It has the following form:
+
+  --  for J4b in 10 .. 12 loop
+  -- declare
+  --procedure __finalizer;
+  -- begin
+  --procedure __finalizer is
+  --  ...
+  --end;
+  --...
+  --obj (J4b) := ...;
+
+  --  When the compiler creates the N_Block_Statement, it sets its scope to
+  --  the upper scope (the one containing the loop).
+
+  --  The Unnest_Loop procedure moves the N_Loop_Statement inside a new
+  --  procedure and correctly sets the scopes for both the new procedure
+  --  and the loop entity. The inner block scope is not modified and this
+  --  leaves the Tree in an incoherent state (i.e. the inner procedure must
+  --  have its enclosing procedure in its scope ancestries).
+
+  --  This procedure fixes the scope links.
+
+  --  Another (better) fix would be to have the block scope set to be the
+  --  loop entity earlier (when the block is created or when the loop gets
+  --  an actual entity set). But unfortunately this proved harder to
+  --  implement ???
+
+  procedure Fixup_Inner_Scopes (Loop_Stmt : Node_Id) is
+ Stmt  : Node_Id:= First (Statements (Loop_Stmt));
+ Loop_Stmt_Ent : constant Entity_Id := Entity (Identifier (Loop_Stmt));
+ Ent_To_Fix: Entity_Id;
+  begin
+ while Present (Stmt) loop
+if Nkind (Stmt) = N_Block_Statement
+  and then Is_Abort_Block (Stmt)
+then
+   Ent_To_Fix := Entity (Identifier (Stmt));
+   Set_Scope (Ent_To_Fix, Loop_Stmt_Ent);
+elsif Nkind (Stmt) = N_Loop_Statement then
+   Fixup_Inner_Scopes (Stmt);
+end if;
+Next (Stmt);
+ end loop;
+  end Fixup_Inner_Scopes;
+
   Loc: constant Source_Ptr := Sloc (Loop_Stmt);
   Ent: Entity_Id;
   Local_Body : Node_Id;
   Local_Call : Node_Id;
+  Loop_Ent   : Entity_Id;
   Local_Proc : Entity_Id;
-  Local_Scop : Entity_Id;
   Loop_Copy  : constant Node_Id :=
  Relocate_Node (Loop_Stmt);
begin
-  Local_Scop := Entity (Identifier (Loop_Stmt));
-  Ent := First_Entity (Local_Scop);
+  Loop_Ent := Entity (Identifier (Loop_Stmt));
+  Ent := First_Entity (Loop_Ent);
 
   Local_Proc := Make_Temporary (Loc, 'P');
 
@@ -9389,8 +9465,10 @@ package body Exp_Ch7 is
   --  New procedu

[COMMITTED] ada: Fix deferred constant wrongly rejected

[Marc Poulhiès]

From: Eric Botcazou 

This recent regression occurs when the nominal subtype of the constant is a
discriminated record type with default discriminants.

gcc/ada/
PR ada/110488
* sem_ch3.adb (Analyze_Object_Declaration): Do not build a default
subtype for a deferred constant in the definite case too.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 6 --
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 92902a7debb..c79d323395f 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5048,9 +5048,11 @@ package body Sem_Ch3 is
 Apply_Length_Check (E, T);
  end if;
 
-  --  When possible, build the default subtype
+  --  When possible, and not a deferred constant, build the default subtype
 
-  elsif Build_Default_Subtype_OK (T) then
+  elsif Build_Default_Subtype_OK (T)
+and then (not Constant_Present (N) or else Present (E))
+  then
  if No (E) then
 Act_T := Build_Default_Subtype (T, N);
  else
-- 
2.42.0

[COMMITTED] ada: Crash processing the accessibility level of an actual parameter

[Marc Poulhiès]

From: Javier Miranda 

gcc/ada/

* exp_ch6.adb (Expand_Call_Helper): When computing the
accessibility level of an actual parameter based on the
expresssion of a constant declaration, add missing support for
deferred constants

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 24 +---
 1 file changed, 17 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index beb2e2f90f0..c1d5fa3c08b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4352,13 +4352,23 @@ package body Exp_Ch6 is
--  Generate the accessibility level based on the expression in
--  the constant's declaration.
 
-   Add_Extra_Actual
- (Expr => Accessibility_Level
-(Expr=> Expression
-  (Parent (Entity (Prev))),
- Level   => Dynamic_Level,
- Allow_Alt_Model => False),
-  EF   => Extra_Accessibility (Formal));
+   declare
+  Ent : Entity_Id := Entity (Prev);
+
+   begin
+  --  Handle deferred constants
+
+  if Present (Full_View (Ent)) then
+ Ent := Full_View (Ent);
+  end if;
+
+  Add_Extra_Actual
+(Expr => Accessibility_Level
+   (Expr=> Expression (Parent (Ent)),
+Level   => Dynamic_Level,
+Allow_Alt_Model => False),
+ EF   => Extra_Accessibility (Formal));
+   end;
 
 --  Normal case
 
-- 
2.42.0

[COMMITTED] ada: Update personality function for CHERI purecap

[Marc Poulhiès]

From: Daniel King 

This makes two changes to the GNAT personality function to reflect
differences for pure capability CHERI/Morello. The first is to use
__builtin_code_address_from_pointer to drop the LSB from Morello
code pointers when searching through call-site tables (without this
we would never find the right landing pad when unwinding).

The second change is to reflect the change in the exception table
format for pure-capability Morello where the landing pad is a capability
indirected by an offset in the call-site table.

gcc/ada/

* raise-gcc.c (get_ip_from_context): Adapt for CHERI purecap
(get_call_site_action_for): Adapt for CHERI purecap

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/raise-gcc.c | 39 ---
 1 file changed, 36 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 56ddfc5a6cf..bdf1c26e612 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -50,10 +50,12 @@
 
 #ifdef __cplusplus
 # include 
+# include 
 # include 
 #else
 # include 
 # include 
+# include 
 # include 
 #endif
 
@@ -592,6 +594,11 @@ get_ip_from_context (_Unwind_Context *uw_context)
 #else
   _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
 #endif
+
+#if !defined(__USING_SJLJ_EXCEPTIONS__) && defined(__CHERI__)
+  ip = __builtin_code_address_from_pointer ((void *)ip);
+#endif
+
   /* Subtract 1 if necessary because GetIPInfo yields a call return address
  in this case, while we are interested in information for the call point.
  This does not always yield the exact call instruction address but always
@@ -850,7 +857,27 @@ get_call_site_action_for (_Unwind_Ptr ip,
   /* Note that all call-site encodings are "absolute" displacements.  */
   p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
   p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
+#ifdef __CHERI_PURE_CAPABILITY__
+  // Single uleb128 value as the capability marker.
+  _Unwind_Ptr marker = 0;
+  p = read_encoded_value (0, DW_EH_PE_uleb128, p, &marker);
+  if (marker == 0xd)
+   {
+ /* 8-byte offset to the (indirected) capability. */
+ p = read_encoded_value (0, DW_EH_PE_pcrel | DW_EH_PE_udata8, p,
+ &cs_lp);
+   }
+  else if (marker)
+   {
+ /* Unsupported landing pad marker value. */
+ abort ();
+   }
+  else
+   cs_lp = 0; // No landing pad.
+#else
   p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
+#endif
+
   p = read_uleb128 (p, &cs_action);
 
   db (DB_CSITE,
@@ -859,18 +886,24 @@ get_call_site_action_for (_Unwind_Ptr ip,
  (char *)region->lp_base + cs_lp, (void *)cs_lp);
 
   /* The table is sorted, so if we've passed the IP, stop.  */
-  if (ip < region->base + cs_start)
+  if (ip < region->base + (size_t)cs_start)
break;
 
   /* If we have a match, fill the ACTION fields accordingly.  */
-  else if (ip < region->base + cs_start + cs_len)
+  else if (ip < region->base + (size_t)cs_start + (size_t)cs_len)
{
  /* Let the caller know there may be an action to take, but let it
 determine the kind.  */
  action->kind = unknown;
 
  if (cs_lp)
-   action->landing_pad = region->lp_base + cs_lp;
+   {
+#ifdef __CHERI_PURE_CAPABILITY__
+ action->landing_pad = *(_Unwind_Ptr *)cs_lp;
+#else
+ action->landing_pad = region->lp_base + cs_lp;
+#endif
+   }
  else
action->landing_pad = 0;
 
-- 
2.42.0

[COMMITTED] ada: Fix missing call to Finalize_Protection for simple protected objects

[Marc Poulhiès]

From: Eric Botcazou 

There is a glitch in Exp_Ch7.Build_Finalizer causing the finalizer to do
nothing for simple protected objects.

The change also removes redundant calls to the Is_Simple_Protected_Type
predicate and fixes a minor inconsistency between Requires_Cleanup_Actions
and Build_Finalizer for this case.

gcc/ada/

* exp_ch7.adb (Build_Finalizer.Process_Declarations): Remove call
to Is_Simple_Protected_Type as redundant.
(Build_Finalizer.Process_Object_Declaration): Do not retrieve the
corresponding record type for simple protected objects. Make the
flow of control more explicit in their specific processing.
* exp_util.adb (Requires_Cleanup_Actions): Return false for simple
protected objects present in library-level package bodies for the
sake of consistency with Build_Finalizer and remove call to
Is_Simple_Protected_Type as redundant.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch7.adb  | 19 ++-
 gcc/ada/exp_util.adb | 32 ++--
 2 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 585acd8b428..5049de54dd7 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2356,8 +2356,7 @@ package body Exp_Ch7 is
 
elsif Ekind (Obj_Id) = E_Variable
  and then not In_Library_Level_Package_Body (Obj_Id)
- and then (Is_Simple_Protected_Type (Obj_Typ)
-or else Has_Simple_Protected_Object (Obj_Typ))
+ and then Has_Simple_Protected_Object (Obj_Typ)
then
   Processing_Actions (Is_Protected => True);
end if;
@@ -3006,7 +3005,9 @@ package body Exp_Ch7 is
   --  Start of processing for Process_Object_Declaration
 
   begin
- --  Handle the object type and the reference to the object
+ --  Handle the object type and the reference to the object. Note
+ --  that objects having simple protected components must retain
+ --  their original form for the processing below to work.
 
  Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
  Obj_Typ := Base_Type (Etype (Obj_Id));
@@ -3018,6 +3019,7 @@ package body Exp_Ch7 is
 
 elsif Is_Concurrent_Type (Obj_Typ)
   and then Present (Corresponding_Record_Type (Obj_Typ))
+  and then not Is_Protected
 then
Obj_Typ := Corresponding_Record_Type (Obj_Typ);
Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref);
@@ -3180,12 +3182,11 @@ package body Exp_Ch7 is
   Fin_Stmts := New_List (Fin_Call);
end if;
 
-elsif Has_Simple_Protected_Object (Obj_Typ) then
-   if Is_Record_Type (Obj_Typ) then
-  Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ);
-   elsif Is_Array_Type (Obj_Typ) then
-  Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ);
-   end if;
+elsif Is_Array_Type (Obj_Typ) then
+   Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ);
+
+else
+   Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ);
 end if;
 
 --  Generate:
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 9ac64fe9381..1aff5a062ce 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13100,10 +13100,38 @@ package body Exp_Util is
 --  Simple protected objects which use type System.Tasking.
 --  Protected_Objects.Protection to manage their locks should be
 --  treated as controlled since they require manual cleanup.
+--  The only exception is illustrated in the following example:
+
+-- package Pkg is
+--type Ctrl is new Controlled ...
+--procedure Finalize (Obj : in out Ctrl);
+--Lib_Obj : Ctrl;
+-- end Pkg;
+
+-- package body Pkg is
+--protected Prot is
+--   procedure Do_Something (Obj : in out Ctrl);
+--end Prot;
+
+--protected body Prot is
+--   procedure Do_Something (Obj : in out Ctrl) is ...
+--end Prot;
+
+--procedure Finalize (Obj : in out Ctrl) is
+--begin
+--   Prot.Do_Something (Obj);
+--end Finalize;
+-- end Pkg;
+
+--  Since for the most part entities in package bodies depend on
+--  those in package specs, Prot's lock should be cleaned up
+--  first. The subsequent cleanup of the spec finalizes Lib_Obj.
+--  This act however attempts to invoke Do_Something and fails
+--  because the lock has disappeared.
 

[COMMITTED] ada: Add CHERI variant of System.Stream_Attributes

[Marc Poulhiès]

From: Daniel King 

Reading and writing System.Address to a stream on CHERI targets does
not preserve the capability tag; it will always be invalid since
a valid capability cannot be created out of thin air. Reading an Address
from a stream would therefore never yield a capability that can be
dereferenced.

This patch introduces a CHERI variant of System.Stream_Attributes that
raises Program_Error when attempting to read a System.Address from a stream.

gcc/ada/

* libgnat/s-stratt__cheri.adb: New file

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-stratt__cheri.adb | 1019 +++
 1 file changed, 1019 insertions(+)
 create mode 100644 gcc/ada/libgnat/s-stratt__cheri.adb

diff --git a/gcc/ada/libgnat/s-stratt__cheri.adb 
b/gcc/ada/libgnat/s-stratt__cheri.adb
new file mode 100644
index 000..f753cf3bf00
--- /dev/null
+++ b/gcc/ada/libgnat/s-stratt__cheri.adb
@@ -0,0 +1,1019 @@
+--
+--  --
+-- GNAT RUN-TIME COMPONENTS --
+--  --
+-- S Y S T E M . S T R E A M _ A T T R I B U T E S  --
+--  --
+-- B o d y  --
+--  --
+--  Copyright (C) 1992-2023, Free Software Foundation, Inc. --
+--  --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+--  --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.   --
+--  --
+-- You should have received a copy of the GNU General Public License and--
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see--
+-- .  --
+--  --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.  --
+--  --
+--
+
+--  This is the CHERI variant of this package
+
+with Ada.IO_Exceptions;
+with Ada.Streams; use Ada.Streams;
+with Ada.Unchecked_Conversion;
+with System.Stream_Attributes.XDR;
+
+package body System.Stream_Attributes is
+
+   XDR_Stream : constant Integer;
+   pragma Import (C, XDR_Stream, "__gl_xdr_stream");
+   --  This imported value is used to determine whether the build had the
+   --  binder switch "-xdr" present which enables XDR streaming and sets this
+   --  flag to 1.
+
+   function XDR_Support return Boolean is (XDR_Stream = 1);
+   pragma Inline (XDR_Support);
+   --  Return True if XDR streaming should be used. Note that 128-bit integers
+   --  are not supported by the XDR protocol and will raise Device_Error.
+
+   Err : exception renames Ada.IO_Exceptions.End_Error;
+   --  Exception raised if insufficient data read (note that the RM implies
+   --  that Data_Error might be the appropriate choice, but AI95-00132
+   --  decides with a binding interpretation that End_Error is preferred).
+
+   SU : constant := System.Storage_Unit;
+
+   subtype SEA is Ada.Streams.Stream_Element_Array;
+   subtype SEO is Ada.Streams.Stream_Element_Offset;
+
+   generic function UC renames Ada.Unchecked_Conversion;
+
+   --  Subtypes used to define Stream_Element_Array values that map
+   --  into the elementary types, using unchecked conversion.
+
+   Thin_Pointer_Size : constant := System.Address'Size;
+   Fat_Pointer_Size  : constant := System.Address'Size * 2;
+
+   subtype S_AD   is SEA (1 .. (Fat_Pointer_Size  + SU - 1) / SU);
+   subtype S_AS   is SEA (1 .. (Thin_Pointer_Size + SU - 1) 

[COMMITTED] ada: Fix missing finalization of extended return object on abnormal completion

[Marc Poulhiès]

From: Eric Botcazou 

This happens in the case of a nonlimited return type and is a fallout of the
optimization recently implemented for them.

gcc/ada/

* einfo.ads (Status_Flag_Or_Transient_Decl): Remove ??? comment.
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Extend the
handling of finalizable return objects to the non-BIP case.
* exp_ch7.adb (Build_Finalizer.Process_Declarations): Adjust the
comment accordingly.
* exp_util.adb (Requires_Cleanup_Actions): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/einfo.ads| 8 
 gcc/ada/exp_ch6.adb  | 4 ++--
 gcc/ada/exp_ch7.adb  | 6 +++---
 gcc/ada/exp_util.adb | 6 +++---
 4 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 977392899f9..9165fb7485d 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -4518,11 +4518,11 @@ package Einfo is
 --Status_Flag_Or_Transient_Decl
 --   Defined in constant, loop, and variable entities. Applies to objects
 --   that require special treatment by the finalization machinery, such as
---   extended return results, IF and CASE expression results, and objects
+--   extended return objects, conditional expression results, and objects
 --   inside N_Expression_With_Actions nodes. The attribute contains the
---   entity of a flag which specifies particular behavior over a region of
---   code or the declaration of a "hook" object.
---   In which case is it a flag, or a hook object???
+--   entity of a flag which specifies a particular behavior over a region
+--   of the extended return for the return objects, or the declaration of a
+--   hook object for conditional expressions and N_Expression_With_Actions.
 
 --Storage_Size_Variable [implementation base type only]
 --   Defined in access types and task type entities. This flag is set
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a16dfe2d57e..beb2e2f90f0 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5607,7 +5607,7 @@ package body Exp_Ch6 is
   --  with the scope finalizer. There is one flag per each return object
   --  in case of multiple returns.
 
-  if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
+  if Needs_Finalization (Etype (Ret_Obj_Id)) then
  declare
 Flag_Decl : Node_Id;
 Flag_Id   : Entity_Id;
@@ -5706,7 +5706,7 @@ package body Exp_Ch6 is
  --  Update the state of the function right before the object is
  --  returned.
 
- if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
+ if Needs_Finalization (Etype (Ret_Obj_Id)) then
 declare
Flag_Id : constant Entity_Id :=
Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 4ea5e6ede64..271dfd22618 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2381,9 +2381,9 @@ package body Exp_Ch7 is
elsif Is_Ignored_Ghost_Entity (Obj_Id) then
   null;
 
-   --  Return object of a build-in-place function. This case is
-   --  recognized and marked by the expansion of an extended return
-   --  statement (see Expand_N_Extended_Return_Statement).
+   --  Return object of extended return statements. This case is
+   --  recognized and marked by the expansion of extended return
+   --  statements (see Expand_N_Extended_Return_Statement).
 
elsif Needs_Finalization (Obj_Typ)
  and then Is_Return_Object (Obj_Id)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2e6a1cf892e..9ac64fe9381 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13127,9 +13127,9 @@ package body Exp_Util is
 elsif Is_Ignored_Ghost_Entity (Obj_Id) then
null;
 
---  Return object of a build-in-place function. This case is
---  recognized and marked by the expansion of an extended return
---  statement (see Expand_N_Extended_Return_Statement).
+--  Return object of extended return statements. This case is
+--  recognized and marked by the expansion of extended return
+--  statements (see Expand_N_Extended_Return_Statement).
 
 elsif Needs_Finalization (Obj_Typ)
   and then Is_Return_Object (Obj_Id)
-- 
2.42.0

[COMMITTED] ada: Dimensional analysis when used with elementary functions

[Marc Poulhiès]

From: Derek Schacht 

gcc/ada/

* doc/gnat_ugn/gnat_and_program_execution.rst: Add more details on
using Generic Elementary Functions with dimensional analysis.
* gnat_ugn.texi: Regenerate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 .../gnat_ugn/gnat_and_program_execution.rst   | 12 
 gcc/ada/gnat_ugn.texi | 19 +--
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst 
b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
index 62abca24f41..35e34772658 100644
--- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
+++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
@@ -3294,6 +3294,18 @@ requires ``DV(Source)`` = ``DV(Target)``, and 
analogously for parameter
 passing (the dimension vector for the actual parameter must be equal to the
 dimension vector for the formal parameter).
 
+When using dimensioned types with elementary functions it is necessary to
+instantiate the ``Ada.Numerics.Generic_Elementary_Functions`` package using
+the ``Mks_Type`` and not any of the derived subtypes such as ``Distance``.
+For functions such as ``Sqrt`` the dimensional analysis will fail when using
+the subtypes because both the parameter and return are of the same type.
+
+An example instantiation
+
+  .. code-block:: ada
+  
+package Mks_Numerics is new 
+   Ada.Numerics.Generic_Elementary_Functions (System.Dim.Mks.Mks_Type);
 
 .. _Stack_Related_Facilities:
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 7c5926eba64..1562bee1f64 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT User's Guide for Native Platforms , Aug 31, 2023
+GNAT User's Guide for Native Platforms , Sep 26, 2023
 
 AdaCore
 
@@ -15510,7 +15510,6 @@ Linker to be used. The default is @code{bfd} for 
@code{ld.bfd}; @code{gold}
 (for @code{ld.gold}) and @code{mold} (for @code{ld.mold}) are more
 recent and faster alternatives, but only available on GNU/Linux
 platforms.
-
 @end table
 
 @node Binding with gnatbind,Linking with gnatlink,Linker Switches,Building 
Executable Programs with GNAT
@@ -22093,6 +22092,22 @@ requires @code{DV(Source)} = @code{DV(Target)}, and 
analogously for parameter
 passing (the dimension vector for the actual parameter must be equal to the
 dimension vector for the formal parameter).
 
+When using dimensioned types with elementary functions it is necessary to
+instantiate the @code{Ada.Numerics.Generic_Elementary_Functions} package using
+the @code{Mks_Type} and not any of the derived subtypes such as 
@code{Distance}.
+For functions such as @code{Sqrt} the dimensional analysis will fail when using
+the subtypes because both the parameter and return are of the same type.
+
+An example instantiation
+
+@quotation
+
+@example
+package Mks_Numerics is new
+   Ada.Numerics.Generic_Elementary_Functions (System.Dim.Mks.Mks_Type);
+@end example
+@end quotation
+
 @node Stack Related Facilities,Memory Management Issues,Performing 
Dimensionality Analysis in GNAT,GNAT and Program Execution
 @anchor{gnat_ugn/gnat_and_program_execution 
id52}@anchor{14d}@anchor{gnat_ugn/gnat_and_program_execution 
stack-related-facilities}@anchor{1aa}
 @section Stack Related Facilities
-- 
2.42.0

[COMMITTED] ada: Fix conversions between addresses and integers

[Marc Poulhiès]

From: Daniel King 

On CHERI targets the size of System.Address and Integer_Address
(or similar) are not the same. The operations in System.Storage_Elements
should be used to convert between integers and addresses.

gcc/ada/

* libgnat/a-tags.adb (To_Tag): Use System.Storage_Elements for
integer to address conversion.
* libgnat/s-putima.adb (Put_Image_Pointer): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/a-tags.adb   | 5 -
 gcc/ada/libgnat/s-putima.adb | 6 ++
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb
index 3590785aa44..1ffc78ed1e8 100644
--- a/gcc/ada/libgnat/a-tags.adb
+++ b/gcc/ada/libgnat/a-tags.adb
@@ -93,7 +93,10 @@ package body Ada.Tags is
--  Disable warnings on possible aliasing problem
 
function To_Tag is
- new Unchecked_Conversion (Integer_Address, Tag);
+ new Unchecked_Conversion (System.Address, Tag);
+
+   function To_Tag (S : Integer_Address) return Tag is
+ (To_Tag (To_Address (S)));
 
function To_Dispatch_Table_Ptr is
   new Ada.Unchecked_Conversion (Tag, Dispatch_Table_Ptr);
diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index 1d6e6085928..bcc7af2ebf5 100644
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -32,7 +32,7 @@
 with Ada.Strings.Text_Buffers.Utils;
 use Ada.Strings.Text_Buffers;
 use Ada.Strings.Text_Buffers.Utils;
-with Ada.Unchecked_Conversion;
+with System.Storage_Elements; use System.Storage_Elements;
 
 package body System.Put_Images is
 
@@ -132,15 +132,13 @@ package body System.Put_Images is
procedure Put_Image_Pointer
  (S : in out Sink'Class; X : Pointer; Type_Kind : String)
is
-  function Cast is new Ada.Unchecked_Conversion
-(System.Address, Unsigned_Address);
begin
   if X = null then
  Put_UTF_8 (S, "null");
   else
  Put_UTF_8 (S, "(");
  Put_UTF_8 (S, Type_Kind);
- Hex.Put_Image (S, Cast (X.all'Address));
+ Hex.Put_Image (S, Unsigned_Address (To_Integer (X.all'Address)));
  Put_UTF_8 (S, ")");
   end if;
end Put_Image_Pointer;
-- 
2.42.0

[COMMITTED] ada: Define CHERI exception types

[Marc Poulhiès]

From: Daniel King 

These exception types map to the CHERI hardware exceptions that are
triggered due to misuse of capabilities.

gcc/ada/

* libgnat/i-cheri.ads (Capability_Bound_Error)
(Capability_Permission_Error, Capability_Sealed_Error)
(Capability_Tag_Error): New, define CHERI exception types.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/i-cheri.ads | 16 
 1 file changed, 16 insertions(+)

diff --git a/gcc/ada/libgnat/i-cheri.ads b/gcc/ada/libgnat/i-cheri.ads
index 547b033dbaf..80985212589 100644
--- a/gcc/ada/libgnat/i-cheri.ads
+++ b/gcc/ada/libgnat/i-cheri.ads
@@ -467,4 +467,20 @@ is
  External_Name => "__builtin_cheri_stack_get";
--  Get the Capability Stack Pointer (CSP)
 
+   ---
+   -- Capability Exceptions --
+   ---
+
+   Capability_Bound_Error : exception;
+   --  An out-of-bounds access was attempted
+
+   Capability_Permission_Error : exception;
+   --  An attempted access exceeded the permissions granted by a capability
+
+   Capability_Sealed_Error : exception;
+   --  A sealed capability was dereferenced
+
+   Capability_Tag_Error : exception;
+   --  An invalid capability was dereferenced
+
 end Interfaces.CHERI;
-- 
2.42.0

[COMMITTED] ada: Make minor corrections to CUDA-related comments

[Marc Poulhiès]

From: Ronan Desplanques 

gcc/ada/

* exp_prag.adb: Make minor corrections in comments.
* rtsfind.ads: Remove unused element from RTU_Id definition.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_prag.adb | 8 
 gcc/ada/rtsfind.ads  | 1 -
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 1cc4653a3b0..d2807cdc7ef 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -685,7 +685,7 @@ package body Exp_Prag is
--Blocks_Id'address,
--Mem_Id'address,
--Stream_Id'address),
-   --  CUDA.Runtime_Api.Launch_Kernel (
+   --  CUDA.Internal.Launch_Kernel (
--My_Proc'Address,
--Blocks_Id,
--Grids_Id,
@@ -703,7 +703,7 @@ package body Exp_Prag is
  Decls  : List_Id;
  Copies : Elist_Id);
   --  For each parameter in list Params, create an object declaration of
-  --  the followinng form:
+  --  the following form:
   --
   --Copy_Id : Param_Typ := Param_Val;
   --
@@ -755,8 +755,8 @@ package body Exp_Prag is
  Kernel_Arg : Entity_Id;
  Memory : Entity_Id;
  Stream : Entity_Id) return Node_Id;
-  --  Builds and returns a call to CUDA.Launch_Kernel using the given
-  --  arguments. Proc is the entity of the procedure passed to the
+  --  Builds and returns a call to CUDA.Internal.Launch_Kernel using the
+  --  given arguments. Proc is the entity of the procedure passed to the
   --  CUDA_Execute pragma. Grid_Dims and Block_Dims are entities of the
   --  generated declarations that hold the kernel's dimensions. Args is the
   --  entity of the temporary array that holds the arguments of the kernel.
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 881f723dfa9..669f6df79cb 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -179,7 +179,6 @@ package Rtsfind is
 
   CUDA_Driver_Types,
   CUDA_Internal,
-  CUDA_Runtime_Api,
   CUDA_Vector_Types,
 
   --  Interfaces
-- 
2.42.0

[COMMITTED] ada: Clarify RM references that justify a constraint check

[Marc Poulhiès]

From: Yannick Moy 

gcc/ada/

* exp_ch5.adb (Expand_N_Case_Statement): Reference both sections
of the Ada RM that deal with case statements and case expressions
to justify the insertion of a runtime check.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch5.adb | 7 ---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index d55fdb3e2e5..cd3b02b9360 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -4092,8 +4092,9 @@ package body Exp_Ch5 is
  end if;
 
  --  First step is to worry about possible invalid argument. The RM
- --  requires (RM 5.4(13)) that if the result is invalid (e.g. it is
- --  outside the base range), then Constraint_Error must be raised.
+ --  requires (RM 4.5.7 (21/3) and 5.4 (13)) that if the result is
+ --  invalid (e.g. it is outside the base range), then Constraint_Error
+ --  must be raised.
 
  --  Case of validity check required (validity checks are on, the
  --  expression is not known to be valid, and the case statement
@@ -4274,7 +4275,7 @@ package body Exp_Ch5 is
 
 --  If Predicates_Ignored is true the value does not satisfy the
 --  predicate, and there is no Others choice, Constraint_Error
---  must be raised (4.5.7 (21/3)).
+--  must be raised (RM 4.5.7 (21/3) and 5.4 (13)).
 
 if Predicates_Ignored (Etype (Expr)) then
declare
-- 
2.42.0

[COMMITTED] ada: TSS finalize address subprogram generation for constrained...

[Marc Poulhiès]

From: Richard Wai 

...subtypes of unconstrained synchronized private extensions should take
care to designate the corresponding record of the underlying concurrent
type.

When generating TSS finalize address subprograms for class-wide types of
constrained root types, it follows the parent chain looking for the
first "non-constrained" type. It is possible that such a type is a
private extension with the “synchronized” keyword, in which case the
underlying type is a concurrent type. When that happens, the designated
type of the finalize address subprogram should be the corresponding
record’s class-wide-type.

gcc/ada/ChangeLog:
* exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Expanded comments
explaining why TSS Finalize_Address is not generated for
concurrent class-wide types.
* exp_ch7.adb (Make_Finalize_Address_Stmts): Handle cases where the
underlying non-constrained parent type is a concurrent type, and
adjust the designated type to be the corresponding record’s
class-wide type.

gcc/testsuite/ChangeLog:

* gnat.dg/sync_tag_finalize.adb: New test.

Signed-off-by: Richard Wai 
---
 gcc/ada/exp_ch3.adb |  4 ++
 gcc/ada/exp_ch7.adb | 28 +-
 gcc/testsuite/gnat.dg/sync_tag_finalize.adb | 60 +
 3 files changed, 90 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/sync_tag_finalize.adb

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 04c3ad8c631..bb015986200 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5000,6 +5000,10 @@ package body Exp_Ch3 is
   --  Do not create TSS routine Finalize_Address for concurrent class-wide
   --  types. Ignore C, C++, CIL and Java types since it is assumed that the
   --  non-Ada side will handle their destruction.
+  --
+  --  Concurrent Ada types are functionally represented by an associated
+  --  "corresponding record type" (typenameV), which owns the actual TSS
+  --  finalize bodies for the type (and technically class-wide type).
 
   elsif Is_Concurrent_Type (Root)
 or else Is_C_Derivation (Root)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index aa16c707887..4ea5e6ede64 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -8512,7 +8512,8 @@ package body Exp_Ch7 is
   Is_Empty_Elmt_List (Discriminant_Constraint (Root_Type (Typ)))
   then
  declare
-Parent_Typ : Entity_Id;
+Parent_Typ  : Entity_Id;
+Parent_Utyp : Entity_Id;
 
  begin
 --  Climb the parent type chain looking for a non-constrained type
@@ -8533,7 +8534,30 @@ package body Exp_Ch7 is
Parent_Typ := Underlying_Record_View (Parent_Typ);
 end if;
 
-Desig_Typ := Class_Wide_Type (Underlying_Type (Parent_Typ));
+Parent_Utyp := Underlying_Type (Parent_Typ);
+
+--  Handle views created for a synchronized private extension with
+--  known, non-defaulted discriminants. In that case, parent_typ
+--  will be the private extension, as it is the first "non
+--  -constrained" type in the parent chain. Unfortunately, the
+--  underlying type, being a protected or task type, is not the
+--  "real" type needing finalization. Rather, the "corresponding
+--  record type" should be the designated type here. In fact, TSS
+--  finalizer generation is specifically skipped for the nominal
+--  class-wide type of (the full view of) a concurrent type (see
+--  exp_ch7.Expand_Freeze_Class_Wide_Type). If we don't designate
+--  the underlying record (Tprot_typeVC), we will end up trying to
+--  dispatch to prot_typeVDF from an incorrectly designated
+--  Tprot_typeC, which is, of course, not actually a member of
+--  prot_typeV'Class, and thus incompatible.
+
+if Ekind (Parent_Utyp) in Concurrent_Kind
+  and then Present (Corresponding_Record_Type (Parent_Utyp))
+then
+   Parent_Utyp := Corresponding_Record_Type (Parent_Utyp);
+end if;
+
+Desig_Typ := Class_Wide_Type (Parent_Utyp);
  end;
 
   --  General case
diff --git a/gcc/testsuite/gnat.dg/sync_tag_finalize.adb 
b/gcc/testsuite/gnat.dg/sync_tag_finalize.adb
new file mode 100644
index 000..6dffd4a102c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_tag_finalize.adb
@@ -0,0 +1,60 @@
+--  In previous versions of GNAT there was a curious bug that caused
+--  compilation to fail in the case of a synchronized private extension
+--  with non-default discriminants, where the creation of a constrained object
+--  (and thus subtype) caused the TSS deep finalize machinery of the internal
+--  class-wide constratined subtype (TConstrainedC) to construct a malformed
+--  T

[COMMITTED] ada: Private extensions with the keyword "synchronized" are always limited.

[Marc Poulhiès]

From: Richard Wai 

GNAT was relying on synchronized private type extensions deriving from a
concurrent interface to determine its limitedness. This does not cover the case
where such an extension derives a limited interface. RM-7.6(6/2) makes is clear
that "synchronized" in a private extension implies the derived type is limited.
GNAT should explicitly check for the presence of "synchronized" in a private
extension declaration, and it should have the same effect as the presence of
“limited”.

gcc/ada/ChangeLog:

* sem_ch3.adb (Build_Derived_Record_Type): Treat presence of
keyword "synchronized" the same as "limited" when determining if a
private extension is limited.

gcc/testsuite/ChangeLog:

* gnat.dg/sync_tag_discriminals.adb: New test.
* gnat.dg/sync_tag_limited.adb: New test.

Signed-off-by: Richard Wai 
---
 gcc/ada/sem_ch3.adb   | 12 +++--
 .../gnat.dg/sync_tag_discriminals.adb | 51 +++
 gcc/testsuite/gnat.dg/sync_tag_limited.adb| 50 ++
 3 files changed, 110 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
 create mode 100644 gcc/testsuite/gnat.dg/sync_tag_limited.adb

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3262236dd14..92902a7debb 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9599,9 +9599,15 @@ package body Sem_Ch3 is
 
   --  AI-419: Limitedness is not inherited from an interface parent, so to
   --  be limited in that case the type must be explicitly declared as
-  --  limited. However, task and protected interfaces are always limited.
-
-  if Limited_Present (Type_Def) then
+  --  limited, or synchronized. While task and protected interfaces are
+  --  always limited, a synchronized private extension might not inherit
+  --  from such interfaces, and so we also need to recognize the
+  --  explicit limitedness implied by a synchronized private extension
+  --  that does not derive from a synchronized interface (see RM-7.3(6/2)).
+
+  if Limited_Present (Type_Def)
+or else Synchronized_Present (Type_Def)
+  then
  Set_Is_Limited_Record (Derived_Type);
 
   elsif Is_Limited_Record (Parent_Type)
diff --git a/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb 
b/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
new file mode 100644
index 000..b105acf6e98
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
@@ -0,0 +1,51 @@
+-- This test is related to sync_tag_limited in that previous versions of GNAT
+-- failed to consider a synchronized private extension as limited if it was
+-- not derrived from a synchronized interface (i.e. a limited interface). Since
+-- such a private type would not be considered limited, GNAT would fail to
+-- correctly build the expected discriminals later needed by the creation of
+-- the concurrent type's "corresponding record type", leading to a compilation
+-- error where the discriminants of the corresponding record type had no
+-- identifiers.
+--
+-- This test is in addition to sync_tag_limited because the sync_tag_limited
+-- would fail for "legality" reasons (default discriminants not allowed for
+-- a non-limited taged type). It is also an opportunity to ensure that non-
+-- defaulted discriminated synchronized private extensions work as expected.
+
+--  { dg-do compile }
+
+procedure Sync_Tag_Discriminals is
+   
+   package Ifaces is
+  
+  type Test_Interface is limited interface;
+  
+  procedure Interface_Action (Test: in out Test_Interface) is abstract;
+  
+   end Ifaces;
+   
+   
+   package Implementation is
+  type Test_Implementation
+(Constraint: Positive) is
+synchronized new Ifaces.Test_Interface with private;
+  
+   private
+  protected type Test_Implementation
+(Constraint: Positive)
+  is new Ifaces.Test_Interface with
+  
+ overriding procedure Interface_Action;
+ 
+  end Test_Implementation;
+   end Implementation;
+   
+   package body Implementation is
+  protected body Test_Implementation is
+ procedure Interface_Action is null;
+  end;
+   end Implementation;
+   
+begin
+   null;
+end Sync_Tag_Discriminals;
diff --git a/gcc/testsuite/gnat.dg/sync_tag_limited.adb 
b/gcc/testsuite/gnat.dg/sync_tag_limited.adb
new file mode 100644
index 000..608f10662a3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_tag_limited.adb
@@ -0,0 +1,50 @@
+--  Synchronized tagged types created by a private extension with the keyword
+--  'synchronized' shall be seen as an (immutably) limited tagged type, and
+--  should therefore accept default disciminant spectifications.
+--  This was a bug in earlier versions of GNAT, whereby GNAT erroneously
+--  relied on a parent synchronized interface to determine limitedness
+--  of a synchronized private extension. The problem being that a sync

[COMMITTED] ada: Refine upper array bound for bit packed array

[Marc Poulhiès]

When using bit-packed arrays, the compiler creates new array subtypes of
1-bit component indexed by integers. The existing routine checks the
index subtype to find the min/max values. Bit-packed arrays being
indexed by integers, the routines gives up as returning the maximum
possible integer carries no useful information.

This change adds a simple max_value routine that can evaluate very
simple expressions by substituting variables by their min/max value.
Bit-packed array subtypes are currently declared as:

  subtype bp_array is packed_bytes1 (0 .. integer((1 * Var +  7) / 8 - 1));

The simple max_value evaluator handles the bare minimum for this
expression pattern.

gcc/ada/ChangeLog:

* gcc-interface/utils.cc (max_value): New.
* gcc-interface/gigi.h (max_value): New.
* gcc-interface/decl.cc (gnat_to_gnu_entity) :
When computing gnu_min/gnu_max, try to use max_value if there is
an initial expression.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/decl.cc  | 22 
 gcc/ada/gcc-interface/gigi.h   |  6 +++
 gcc/ada/gcc-interface/utils.cc | 95 ++
 3 files changed, 123 insertions(+)

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 0cf7d3cee60..5e16b56217c 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2551,6 +2551,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree 
gnu_expr, bool definition)
  else
gnu_min = gnu_orig_min;
 
+ if (DECL_P (gnu_min)
+ && DECL_INITIAL (gnu_min) != NULL_TREE
+ && (TREE_CODE (gnu_min) != INTEGER_CST
+ || TREE_OVERFLOW (gnu_min)))
+   {
+ tree tmp = max_value (DECL_INITIAL(gnu_min), false);
+ if (TREE_CODE (tmp) == INTEGER_CST
+ && !TREE_OVERFLOW (tmp))
+   gnu_min = tmp;
+   }
+
  if (TREE_CODE (gnu_min) != INTEGER_CST
  || TREE_OVERFLOW (gnu_min))
gnu_min = TYPE_MIN_VALUE (TREE_TYPE (gnu_min));
@@ -2560,6 +2571,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree 
gnu_expr, bool definition)
  else
gnu_max = gnu_orig_max;
 
+ if (DECL_P (gnu_max)
+ && DECL_INITIAL (gnu_max) != NULL_TREE
+ && (TREE_CODE (gnu_max) != INTEGER_CST
+ || TREE_OVERFLOW (gnu_max)))
+   {
+ tree tmp = max_value (DECL_INITIAL(gnu_max), true);
+ if (TREE_CODE (tmp) == INTEGER_CST
+ && !TREE_OVERFLOW (tmp))
+   gnu_max = tmp;
+   }
+
  if (TREE_CODE (gnu_max) != INTEGER_CST
  || TREE_OVERFLOW (gnu_max))
gnu_max = TYPE_MAX_VALUE (TREE_TYPE (gnu_max));
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index ec85ce44bc3..eb5496f50db 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -763,6 +763,12 @@ extern void update_pointer_to (tree old_type, tree 
new_type);
minimum (if !MAX_P) possible value of the discriminant.  */
 extern tree max_size (tree exp, bool max_p);
 
+/* Try to compute the maximum (if MAX_P) or minimum (if !MAX_P) value for the
+   expression EXP, for very simple expressions.  Substitute variable references
+   with their respective type's min/max values.  Return the computed value if
+   any, or EXP if no value can be computed. */
+extern tree max_value (tree exp, bool max_p);
+
 /* Remove all conversions that are done in EXP.  This includes converting
from a padded type or to a left-justified modular type.  If TRUE_ADDRESS
is true, always return the address of the containing object even if
diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
index f720f3a3b4a..4e2ed173fbe 100644
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -3830,6 +3830,100 @@ fntype_same_flags_p (const_tree t, tree cico_list, bool 
return_by_direct_ref_p,
 && TREE_ADDRESSABLE (t) == return_by_invisi_ref_p;
 }
 
+/* Try to compute the maximum (if MAX_P) or minimum (if !MAX_P) value for the
+   expression EXP, for very simple expressions.  Substitute variable references
+   with their respective type's min/max values.  Return the computed value if
+   any, or EXP if no value can be computed. */
+
+tree
+max_value (tree exp, bool max_p)
+{
+  enum tree_code code = TREE_CODE (exp);
+  tree type = TREE_TYPE (exp);
+  tree op0, op1, op2;
+
+  switch (TREE_CODE_CLASS (code))
+{
+case tcc_declaration:
+  if (VAR_P (exp))
+return fold_convert (type,
+ max_p
+ ? TYPE_MAX_VALUE (type) : TY

[COMMITTED] ada: Crash processing type invariants on child subprogram

[Marc Poulhiès]

From: Javier Miranda 

gcc/ada/

* contracts.adb
(Has_Public_Visibility_Of_Subprogram): Add missing support for
child subprograms.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/contracts.adb | 25 -
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 77578dacc18..4aaa276495b 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2484,7 +2484,7 @@ package body Contracts is
--  declarations of the package containing the type, or in the
--  visible declaration of a child unit of that package.
 
-   else
+   elsif Is_List_Member (Subp_Decl) then
   declare
  Decls  : constant List_Id   :=
 List_Containing (Subp_Decl);
@@ -2508,6 +2508,29 @@ package body Contracts is
  (Specification
(Unit_Declaration_Node (Subp_Scope;
   end;
+
+   --  Determine whether the subprogram is a child subprogram of
+   --  of the package containing the type.
+
+   else
+  pragma Assert
+(Nkind (Parent (Subp_Decl)) = N_Compilation_Unit);
+
+  declare
+ Subp_Scope : constant Entity_Id :=
+Scope (Defining_Entity (Subp_Decl));
+ Typ_Scope  : constant Entity_Id := Scope (Typ);
+
+  begin
+ return
+   Ekind (Subp_Scope) = E_Package
+ and then
+   (Typ_Scope = Subp_Scope
+  or else
+(Is_Child_Unit (Subp_Scope)
+   and then Is_Ancestor_Package
+  (Typ_Scope, Subp_Scope)));
+  end;
end if;
 end Has_Public_Visibility_Of_Subprogram;
 
-- 
2.40.0

Re: [PATCH 1/2 v3] Ada: Synchronized private extensions are always limited

[Marc Poulhiès via Gcc-patches]

Hello Richard,

> I have added the required “Signed-off-by” tag to the patch and to the change 
> log
> entry below. I believe for all other aspects I have followed the instructions.

Thanks for doing these modifications. I believe you have read the
Developer's Certificate of Origin (https://gcc.gnu.org/dco.html) and
accept it?

> For getting the patch applied it states "If you do not have write access and a
> patch of yours has been approved, but not committed, please advise the 
> approver
> of that fact.” So I think I have done that correctly.. However let me know if
> there is someone else not included in the CC that should be handling that.

I can take it from here and apply both your changes if that's ok with
you.

Thanks for your patches!

Marc

[PATCH] Trivial typo fix in variadic

[Marc Poulhiès via Gcc-patches]

Fix all occurences of varadic, except for Rust (will be part of another change).

gcc/ChangeLog:

* config/nvptx/nvptx.h (struct machine_function): Fix typo in variadic.
* config/nvptx/nvptx.cc (nvptx_function_arg_advance): Adjust to use 
fixed name.
(nvptx_declare_function_name): Likewise.
(nvptx_call_args): Likewise.
(nvptx_expand_call): Likewise.

gcc/cp/ChangeLog:

* lambda.cc (compare_lambda_sig): Fix typo in variadic.

libcpp/ChangeLog:

* macro.cc (parse_params): Fix typo in variadic.
(create_iso_definition): Likewise.

Signed-off-by: Marc Poulhiès 
---

Hi,

I came across this trivial typo and fixed it.

The compiler still builds correctly.
I've bootstraped x86_64-linux.
As I don't really know how to setup nvptx correctly (and not sure
this trivial fix warrants learning the full setup...), I've simply
built the compiler for nvptx-none.

Ok for master?

 gcc/config/nvptx/nvptx.cc | 14 +++---
 gcc/config/nvptx/nvptx.h  |  4 ++--
 gcc/cp/lambda.cc  |  2 +-
 libcpp/macro.cc   | 20 ++--
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index edef39fb5e1..0de42408841 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -720,7 +720,7 @@ nvptx_function_arg_advance (cumulative_args_t cum_v, const 
function_arg_info &)
 
 /* Implement TARGET_FUNCTION_ARG_BOUNDARY.
 
-   For nvptx This is only used for varadic args.  The type has already
+   For nvptx This is only used for variadic args.  The type has already
been promoted and/or converted to invisible reference.  */
 
 static unsigned
@@ -1548,7 +1548,7 @@ nvptx_declare_function_name (FILE *file, const char 
*name, const_tree decl)
   if (!TARGET_SOFT_STACK)
 {
   /* Declare a local var for outgoing varargs.  */
-  if (cfun->machine->has_varadic)
+  if (cfun->machine->has_variadic)
init_frame (file, STACK_POINTER_REGNUM,
UNITS_PER_WORD, crtl->outgoing_args_size);
 
@@ -1558,7 +1558,7 @@ nvptx_declare_function_name (FILE *file, const char 
*name, const_tree decl)
init_frame (file, FRAME_POINTER_REGNUM, alignment,
ROUND_UP (sz, GET_MODE_SIZE (DImode)));
 }
-  else if (need_frameptr || cfun->machine->has_varadic || cfun->calls_alloca
+  else if (need_frameptr || cfun->machine->has_variadic || cfun->calls_alloca
   || (cfun->machine->has_simtreg && !crtl->is_leaf))
 init_softstack_frame (file, alignment, sz);
 
@@ -1795,13 +1795,13 @@ nvptx_call_args (rtx arg, tree fntype)
   if (!cfun->machine->doing_call)
 {
   cfun->machine->doing_call = true;
-  cfun->machine->is_varadic = false;
+  cfun->machine->is_variadic = false;
   cfun->machine->num_args = 0;
 
   if (fntype && stdarg_p (fntype))
{
- cfun->machine->is_varadic = true;
- cfun->machine->has_varadic = true;
+ cfun->machine->is_variadic = true;
+ cfun->machine->has_variadic = true;
  cfun->machine->num_args++;
}
 }
@@ -1871,7 +1871,7 @@ nvptx_expand_call (rtx retval, rtx address)
 }
 
   unsigned nargs = cfun->machine->num_args;
-  if (cfun->machine->is_varadic)
+  if (cfun->machine->is_variadic)
 {
   varargs = gen_reg_rtx (Pmode);
   emit_move_insn (varargs, stack_pointer_rtx);
diff --git a/gcc/config/nvptx/nvptx.h b/gcc/config/nvptx/nvptx.h
index 129427e5654..666021283c2 100644
--- a/gcc/config/nvptx/nvptx.h
+++ b/gcc/config/nvptx/nvptx.h
@@ -209,8 +209,8 @@ struct GTY(()) machine_function
 {
   rtx_expr_list *call_args;  /* Arg list for the current call.  */
   bool doing_call; /* Within a CALL_ARGS ... CALL_ARGS_END sequence.  */
-  bool is_varadic;  /* This call is varadic  */
-  bool has_varadic;  /* Current function has a varadic call.  */
+  bool is_variadic;  /* This call is variadic  */
+  bool has_variadic;  /* Current function has a variadic call.  */
   bool has_chain; /* Current function has outgoing static chain.  */
   bool has_softstack; /* Current function has a soft stack frame.  */
   bool has_simtreg; /* Current function has an OpenMP SIMD region.  */
diff --git a/gcc/cp/lambda.cc b/gcc/cp/lambda.cc
index a359bc6ee8d..34d0190a89b 100644
--- a/gcc/cp/lambda.cc
+++ b/gcc/cp/lambda.cc
@@ -1619,7 +1619,7 @@ compare_lambda_sig (tree fn_a, tree fn_b)
 {
   if (!args_a || !args_b)
return false;
-  // This check also deals with differing varadicness
+  // This check also deals with differing variadicness
   if (!same_type_p (TREE_VALUE (args_a), TREE_VALUE (args_b)))
return false;
 }
diff --git a/libcpp/macro.cc b/libcpp/macro.cc
index dada8fea835..4f229c1501c 100644
--- a/libcpp/macro.cc
+++ b/libcpp/macro.cc
@@ -3431,

[COMMITTED] ada: Explicitly analyze and expand null array aggregates

[Marc Poulhiès via Gcc-patches]

From: Piotr Trojanek 

Null array aggregates have present but empty lists of expressions and
component associations. This confuses the previous code for ordinary
array aggregates, which assumes that if a list of either expressions or
component associations is present, then it is non-empty.

This patch adds explicit handling for null array aggregates to avoid
assertion failures in code for ordinary array aggregates.

gcc/ada/

* exp_aggr.adb (Build_Array_Aggr_Code): Don't build aggregate code
for null array aggregates.
* sem_aggr.adb (Resolve_Array_Aggregate): Don't examine formatting
of a null array aggregate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 5 -
 gcc/ada/sem_aggr.adb | 5 -
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d72e27030e5..165f517c031 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1989,7 +1989,10 @@ package body Exp_Aggr is
 
   --  Skip this if no component associations
 
-  if No (Expressions (N)) then
+  if Is_Null_Aggregate (N) then
+ null;
+
+  elsif No (Expressions (N)) then
 
  --  STEP 1 (a): Sort the discrete choices
 
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e929fea3bb6..597c3ce2dd1 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2081,7 +2081,10 @@ package body Sem_Aggr is
 
   --  STEP 1: make sure the aggregate is correctly formatted
 
-  if Present (Component_Associations (N)) then
+  if Is_Null_Aggregate (N) then
+ null;
+
+  elsif Present (Component_Associations (N)) then
 
  --  Verify that all or none of the component associations
  --  include an iterator specification.
-- 
2.40.0

[COMMITTED] ada: Fix minor glitch in finish_record_type

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The size needs to be rounded up to the storage unit in all cases.

gcc/ada/

* gcc-interface/utils.cc (finish_record_type): Round the size in
the padding case as well.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/utils.cc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
index d0a13d2af33..f720f3a3b4a 100644
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -2159,7 +2159,7 @@ finish_record_type (tree record_type, tree field_list, 
int rep_level,
   /* If this is a padding record, we never want to make the size smaller
 than what was specified in it, if any.  */
   if (TYPE_IS_PADDING_P (record_type) && had_size)
-   size = TYPE_SIZE (record_type);
+   size = round_up (TYPE_SIZE (record_type), BITS_PER_UNIT);
   else
size = round_up (size, BITS_PER_UNIT);
 
-- 
2.40.0

[COMMITTED] ada: Fix internal error on misaligned component with variable nominal size

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The back-end cannot handle this kind of components even when they are small.

gcc/ada/

* exp_util.adb (Component_May_Be_Bit_Aligned): Do not return false
for a small component of a record type with a variant part.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_util.adb | 9 ++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b2542d4ae59..2e6a1cf892e 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4989,12 +4989,15 @@ package body Exp_Util is
  return False;
 
   --  If we know that we have a small (at most the maximum integer size)
-  --  record or bit-packed array, then everything is fine, since the back
-  --  end can handle these cases correctly, except if a slice is involved.
+  --  bit-packed array or record without variant part, then everything is
+  --  fine, since the back end can handle these cases correctly, except if
+  --  a slice is involved.
 
   elsif Known_Esize (Comp)
 and then Esize (Comp) <= System_Max_Integer_Size
-and then (Is_Record_Type (UT) or else Is_Bit_Packed_Array (UT))
+and then (Is_Bit_Packed_Array (UT)
+   or else (Is_Record_Type (UT)
+ and then not Has_Variant_Part (UT)))
 and then not For_Slice
   then
  return False;
-- 
2.40.0

[COMMITTED] ada: Fix wrong optimization of extended return for discriminated record type

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

This happens when the discriminants of the record type have default values.

gcc/ada/ChangeLog:

* inline.adb (Expand_Inlined_Call): In the case of a function call
that returns an unconstrained type and initializes an object, set
the No_Initialization flag on the new declaration of the object.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/inline.adb | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index db8b4164e87..4e8d0f1bb74 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -4157,6 +4157,7 @@ package body Inline is
   Object_Definition   =>
 New_Copy_Tree (Object_Definition (Parent (Targ1;
  Replace_Formals (Decl);
+ Set_No_Initialization (Decl);
  Rewrite (Parent (N), Decl);
  Analyze (Parent (N));
 
-- 
2.40.0

[COMMITTED] ada: Remove GNAT Pro details regarding mold

[Marc Poulhiès via Gcc-patches]

From: Kévin Le Gouguec 

gcc/ada/

* doc/gnat_ugn/building_executable_programs_with_gnat.rst: Remove
extended discussion regarding mold run-time dependencies;
packaging changes in GNAT Pro have made them obsolete.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 ...building_executable_programs_with_gnat.rst | 22 ---
 1 file changed, 22 deletions(-)

diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst 
b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 6c0d2b34a92..6e80163d6d4 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -6317,28 +6317,6 @@ Linker switches can be specified after :switch:`-largs` 
builder switch.
   recent and faster alternatives, but only available on GNU/Linux
   platforms.
 
-  .. only:: PRO
-
-The GNAT distribution for native Linux platforms includes ``mold``,
-compiled against OpenSSL version 1.1; however, the distribution does
-not include OpenSSL.  In order to use this linker, you may either:
-
-* use your system's OpenSSL library, if the version matches: in this
-  situation, you need not do anything beside using the
-  :switch:`-fuse-ld=mold` switch,
-
-* obtain a source distribution for OpenSSL 1.1, compile the
-  :file:`libcrypto.so` library and install it in the directory of
-  your choice, then include this directory in the
-  :envvar:`LD_LIBRARY_PATH` environment variable,
-
-* install another copy of ``mold`` by other means in the directory
-  of your choice, and include this directory in the :envvar:`PATH`
-  environment variable; you may find this alternative preferable if
-  the copy of ``mold`` included in GNAT does not suit your needs
-  (e.g. being able to link against your system's OpenSSL, or using
-  another version of ``mold``).
-
 .. _Binding_with_gnatbind:
 
 Binding with ``gnatbind``
-- 
2.40.0

[COMMITTED] ada: Generate runtime restrictions list when the standard library is suppressed

[Marc Poulhiès via Gcc-patches]

From: Patrick Bernardi 

With the introduction of Jorvik support into the light-tasking runtime comes
the requirement to detect voliations of runtime restrictions (for example
Max_Entry_Queue_Length) where previously they could be hard coded in the
runtime. This means we now need the binder to populate
System.System.Restrictions.Run_Time_Restrictions when the standard library
is suppressed.

gcc/ada/

* bindgen.adb (Gen_Adainit): Generate restrictions when standard
library is suppressed.
(Gen_Output_File_Ada): Ditto.
(Gen_Restrictions): Ditto.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/bindgen.adb | 10 --
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index ae20e5f40d3..87f162e6b43 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -691,6 +691,8 @@ package body Bindgen is
 WBI ("  null;");
  end if;
 
+ Gen_Restrictions;
+
  --  Generate the default-sized secondary stack pool if the secondary
  --  stack is used by the program.
 
@@ -2804,9 +2806,7 @@ package body Bindgen is
   --  Generate with of System.Restrictions to initialize
   --  Run_Time_Restrictions.
 
-  if System_Restrictions_Used
-and not Suppress_Standard_Library_On_Target
-  then
+  if System_Restrictions_Used then
  WBI ("");
  WBI ("with System.Restrictions;");
   end if;
@@ -2946,9 +2946,7 @@ package body Bindgen is
   Count : Integer;
 
begin
-  if Suppress_Standard_Library_On_Target
-or not System_Restrictions_Used
-  then
+  if not System_Restrictions_Used then
  return;
   end if;
 
-- 
2.40.0

[COMMITTED] ada: Do not perform local-exception-to-goto optimization on barrier functions

[Marc Poulhiès via Gcc-patches]

From: Patrick Bernardi 

The local-exception-to-goto optimization is no longer applied to entry
barrier functions as entry barriers cannot contain exception handlers and
this optimization interferes with another optimization that occurs for
simple barrier functions.

In particular, the simple barrier optimization removes the push error label
statements generated by the local-exception-to-goto optimization. This
causes a Storage_Error in GIGI when the restriction No_Exception_Propagation
is  active and a protected object contains more than one simple entry
barrier.

gcc/ada/

* exp_ch6.adb (Expand_N_Subprogram_Body): Do not perform
local-exception-to- goto optimization on barrier functions.
* exp_ch9.adb (Expand_Entry_Barrier): Simplify the if statement
around the simple barrier optimization and remove an old, no
longer relevant comment.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 12 +++-
 gcc/ada/exp_ch9.adb | 38 ++
 2 files changed, 21 insertions(+), 29 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index da1c9e66102..a16dfe2d57e 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6008,16 +6008,18 @@ package body Exp_Ch6 is
 
   --  If local-exception-to-goto optimization active, insert dummy push
   --  statements at start, and dummy pop statements at end, but inhibit
-  --  this if we have No_Exception_Handlers, since they are useless and
-  --  interfere with analysis, e.g. by CodePeer. We also don't need these
-  --  if we're unnesting subprograms because the only purpose of these
-  --  nodes is to ensure we don't set a label in one subprogram and branch
-  --  to it in another.
+  --  this if we have No_Exception_Handlers or expanding a entry barrier
+  --  function, since they are useless and interfere with analysis (e.g. by
+  --  CodePeer) and other optimizations. We also don't need these if we're
+  --  unnesting subprograms because the only purpose of these nodes is to
+  --  ensure we don't set a label in one subprogram and branch to it in
+  --  another.
 
   if (Debug_Flag_Dot_G
or else Restriction_Active (No_Exception_Propagation))
 and then not Restriction_Active (No_Exception_Handlers)
 and then not CodePeer_Mode
+and then not Is_Entry_Barrier_Function (N)
 and then not Unnest_Subprogram_Mode
 and then Is_Non_Empty_List (L)
   then
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 5dcd890c33c..cfdab114c9b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6124,7 +6124,6 @@ package body Exp_Ch9 is
 
   --  Local variables
 
-  Cond_Id: Entity_Id;
   Entry_Body : Node_Id;
   Func_Body  : Node_Id := Empty;
 
@@ -6191,30 +6190,21 @@ package body Exp_Ch9 is
  Check_Unprotected_Barrier (Cond);
   end if;
 
-  if Is_Entity_Name (Cond) then
- Cond_Id := Entity (Cond);
+  --  Perform a small optimization of simple barrier functions. If the
+  --  scope of the condition's entity is not the barrier function, then
+  --  the condition does not depend on any of the generated renamings.
+  --  If this is the case, eliminate the renamings as they are useless.
+  --  This optimization is not performed when the condition was folded
+  --  and validity checks are in effect because the original condition
+  --  may have produced at least one check that depends on the generated
+  --  renamings.
 
- --  Perform a small optimization of simple barrier functions. If the
- --  scope of the condition's entity is not the barrier function, then
- --  the condition does not depend on any of the generated renamings.
- --  If this is the case, eliminate the renamings as they are useless.
- --  This optimization is not performed when the condition was folded
- --  and validity checks are in effect because the original condition
- --  may have produced at least one check that depends on the generated
- --  renamings.
-
- if Expander_Active
-   and then Scope (Cond_Id) /= Func_Id
-   and then not Validity_Check_Operands
- then
-Set_Declarations (Func_Body, Empty_List);
- end if;
-
- --  Note that after analysis variables in this context will be
- --  replaced by the corresponding prival, that is to say a renaming
- --  of a selected component of the form _Object.Var. If expansion is
- --  disabled, as within a generic, we check that the entity appears in
- --  the current scope.
+  if Expander_Active
+and then Is_Entity_Name (Cond)
+and then Scope (Entity (Cond)) /= Func_Id
+and then not Validity_Check_Operands
+  then
+ Set_Declarations (Func_Body, Empty_List);
   e

[COMMITTED] ada: Fix internal error on expression function with Refined_Post aspect

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

This occurs when the expression function calls a protected function and the
-gnata switch is specified, because the compiler wrongly freezes the called
function when analyzing the expression function, a fallout of the wrapping
scheme used for the Post and Refined_Post aspects.

gcc/ada/

* sem_res.adb (Resolve_Call): When the target is an entity, do not
freeze it if the current scope is the inner wrapper function built
for an expression function with a Post or Refined_Post aspect.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_res.adb | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c708d04fc32..b8d8e701ae3 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6582,6 +6582,9 @@ package body Sem_Res is
   if Is_Entity_Name (Subp)
 and then not In_Spec_Expression
 and then not Is_Expression_Function_Or_Completion (Current_Scope)
+and then not (Chars (Current_Scope) = Name_uWrapped_Statements
+   and then Is_Expression_Function_Or_Completion
+  (Scope (Current_Scope)))
 and then
   (not Is_Expression_Function_Or_Completion (Entity (Subp))
 or else Expander_Active)
-- 
2.40.0

[COMMITTED] ada: Fix internal error on aggregate nested in container aggregate

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

This handles the case where a component association is present.

gcc/ada/

* exp_aggr.adb (Convert_To_Assignments): In the case of a
component association, call Is_Container_Aggregate on the parent's
parent.
(Expand_Array_Aggregate): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 16 +---
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cdca24b7d5d..d72e27030e5 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4251,9 +4251,11 @@ package body Exp_Aggr is
  --  excluding container aggregates as these are transformed into
  --  subprogram calls later.
 
- (Parent_Kind in
-N_Component_Association | N_Aggregate | N_Extension_Aggregate
-and then not Is_Container_Aggregate (Parent_Node))
+ (Parent_Kind = N_Component_Association
+   and then not Is_Container_Aggregate (Parent (Parent_Node)))
+
+ or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate
+   and then not Is_Container_Aggregate (Parent_Node))
 
  --  Allocator (see Convert_Aggr_In_Allocator)
 
@@ -6122,10 +6124,10 @@ package body Exp_Aggr is
  Parent_Kind := Nkind (Parent_Node);
   end if;
 
-  if ((Parent_Kind = N_Component_Association
-or else Parent_Kind = N_Aggregate
-or else Parent_Kind = N_Extension_Aggregate)
-   and then not Is_Container_Aggregate (Parent_Node))
+  if (Parent_Kind = N_Component_Association
+   and then not Is_Container_Aggregate (Parent (Parent_Node)))
+or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate
+  and then not Is_Container_Aggregate (Parent_Node))
 or else (Parent_Kind = N_Object_Declaration
   and then (Needs_Finalization (Typ)
  or else Is_Special_Return_Object
-- 
2.40.0

[COMMITTED] ada: Clean up scope depth and related code (tech debt)

[Marc Poulhiès via Gcc-patches]

From: Bob Duff 

The main point of this patch is to remove the special case
for Atree.F_Scope_Depth_Value in the Assert that Field_Present
in Get_Field_Value. Pulling on that thread leads to lots
of related cleanup.

gcc/ada/ChangeLog:

* atree.adb (Node_Kind_Table): Specify parameter explicitly in
GNAT.Table instantiations. Use fully qualified references instead
of relying on use clauses.
(Get_Field_Value): Remove special case for F_Scope_Depth_Value.
That is, enable the Field_Present check in that case.
(It was already enabled for all other fields.) Violations of this
check were already fixed.
(Print_Node_Statistics): Sort the output in decreasing order of
frequencies.
(Print_Field_Statistics): Likewise (sort).
* accessibility.adb (Accessibility_Level): Pass Allow_Alt_Model in
recursive calls. Apparently, an oversight.
(Innermost_Master_Scope_Depth): Need to special-case the 'Old
attribute and allocators.
* einfo-utils.ads (Scope_Depth): Use Scope_Kind_Id to get
predicate checks.
(Scope_Depth_Set): Likewise.
(Scope_Depth_Default_0): Likewise.
* einfo-utils.adb: As for spec.
* frontend.adb (Frontend): Remove unnecessary "return;".
* gen_il-types.ads (Scope_Kind): New union type.
* gen_il-gen-gen_entities.adb (Scope_Kind): New union type.
* sem.ads: Move "with Einfo.Entities;" from body to spec.
(Scope_Stack_Entry): Declare Entity to be of Scope_Kind_Id to get
predicate checks. We had previously been putting non-scopes on the
scope stack; this prevents such anomalies.
* sem.adb: Move "with Einfo.Entities;" from body to spec.
* sem_ch8.ads: Move "with Einfo.Entities;" from body to spec. Add
"with Types;".
(Push_Scope): Use Scope_Kind_Id to get predicate checks.
* sem_ch8.adb: Move "with Einfo.Entities;" from body to spec. Add
"with Types;".
(Push_Scope): Use Scope_Kind_Id to get predicate checks.
(Pop_Scope): Use Scope_Kind_Id on popped entity to get predicate
checks. This prevents anomalies where a scope pushed onto the
stack is later mutated to a nonscope before being popped.
* sem_util.ads (Find_Enclosing_Scope): Add postcondition to ensure
that the enclosing scope of a node N is not the same node N.
Clearly, N does not enclose itself.
* sem_util.adb (Find_Enclosing_Scope): There were several bugs
where Find_Enclosing_Scope(N) = N. For example, if N is an entity,
then we would typically go up to its declaration, and then back
down to the Defining_Entity of the declaration, which is N itself.
There were other cases where Find_Enclosing_Scope of an entity
disagreed with Scope. Clearly, Find_Enclosing_Scope and Scope
should agree (when both are defined). Such bugs caused latent bugs
in accessibility.adb related to 'Old, and fixing bugs here caused
such bugs to be revealed. These are fixed by calling Scope when N
is an entity.

Co-authored-by: Ronan Desplanques 

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/accessibility.adb   |  38 +++--
 gcc/ada/atree.adb   | 210 +---
 gcc/ada/einfo-utils.adb |   6 +-
 gcc/ada/einfo-utils.ads |   6 +-
 gcc/ada/frontend.adb|   2 -
 gcc/ada/gen_il-gen-gen_entities.adb |  27 
 gcc/ada/gen_il-types.ads|   1 +
 gcc/ada/sem.adb |   1 -
 gcc/ada/sem.ads |   3 +-
 gcc/ada/sem_ch8.adb |   5 +-
 gcc/ada/sem_ch8.ads |   5 +-
 gcc/ada/sem_util.adb|   8 +-
 gcc/ada/sem_util.ads|   3 +-
 13 files changed, 231 insertions(+), 84 deletions(-)

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index bc897d1ef18..bc217bef703 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -119,8 +119,9 @@ package body Accessibility is
is
   Loc : constant Source_Ptr := Sloc (Expr);
 
-  function Accessibility_Level (Expr : Node_Id) return Node_Id
-is (Accessibility_Level (Expr, Level, In_Return_Context));
+  function Accessibility_Level (Expr : Node_Id) return Node_Id is
+(Accessibility_Level
+  (Expr, Level, In_Return_Context, Allow_Alt_Model));
   --  Renaming of the enclosing function to facilitate recursive calls
 
   function Make_Level_Literal (Level : Uint) return Node_Id;
@@ -164,7 +165,19 @@ package body Accessibility is
 Ent := Defining_Entity_Or_Empty (Node_Par);
 
 if Present (Ent) then
-   Encl_Scop := Find_Enclosing_Scope (Ent);
+   --  X'Old is nested within the current subprogram, so we do not
+   --  want Find_Enclosing_Scope of that 

[COMMITTED] ada: Crash on creation of extra formals on type extension

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

Revert previous patch and fix the pending issue.

gcc/ada/

* accessibility.ads (Needs_Result_Accessibility_Extra_Formal):
Removed.
* accessibility.adb (Needs_Result_Accessibility_Level_Param):
Removed.
(Needs_Result_Accessibility_Extra_Formal): Removed.
(Needs_Result_Accessibility_Level): Revert previous patch.
* sem_ch6.adb (Parent_Subprogram): Handle function overriding an
enumeration literal.
(Create_Extra_Formals): Ensure that the parent subprogram has all
its extra formals.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/accessibility.adb | 54 ++-
 gcc/ada/accessibility.ads |  9 ---
 gcc/ada/sem_ch6.adb   | 27 
 3 files changed, 24 insertions(+), 66 deletions(-)

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 6b4ec5b9d24..bc897d1ef18 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -56,16 +56,6 @@ with Tbuild; use Tbuild;
 
 package body Accessibility is
 
-   function Needs_Result_Accessibility_Level_Param
- (Func_Id  : Entity_Id;
-  Func_Typ : Entity_Id) return Boolean;
-   --  Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and
-   --  Needs_Result_Accessibility_Level_Param. Return True if the function
-   --  needs an implicit parameter to identify the accessibility level of
-   --  the function result "determined by the point of call". Func_Typ is
-   --  the function return type; this function returns False if Func_Typ is
-   --  Empty.
-
---
-- Accessibility_Message --
---
@@ -1902,34 +1892,6 @@ package body Accessibility is
and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
end Is_Special_Aliased_Formal_Access;
 
-   -
-   -- Needs_Result_Accessibility_Extra_Formal --
-   -
-
-   function Needs_Result_Accessibility_Extra_Formal
- (Func_Id : Entity_Id) return Boolean
-   is
-  Func_Typ : Entity_Id;
-
-   begin
-  if Present (Underlying_Type (Etype (Func_Id))) then
- Func_Typ := Underlying_Type (Etype (Func_Id));
-
-  --  Case of a function returning a private type which is not completed
-  --  yet. The support for this case is required because this function is
-  --  called to create the extra formals of dispatching primitives, and
-  --  they may be frozen before we see the full-view of their returned
-  --  private type.
-
-  else
- --  Temporarily restore previous behavior
- --  Func_Typ := Etype (Func_Id);
- Func_Typ := Empty;
-  end if;
-
-  return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
-   end Needs_Result_Accessibility_Extra_Formal;
-
--
-- Needs_Result_Accessibility_Level --
--
@@ -1939,18 +1901,6 @@ package body Accessibility is
is
   Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
 
-   begin
-  return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
-   end Needs_Result_Accessibility_Level;
-
-   
-   -- Needs_Result_Accessibility_Level_Param --
-   
-
-   function Needs_Result_Accessibility_Level_Param
- (Func_Id  : Entity_Id;
-  Func_Typ : Entity_Id) return Boolean
-   is
   function Has_Unconstrained_Access_Discriminant_Component
 (Comp_Typ : Entity_Id) return Boolean;
   --  Returns True if any component of the type has an unconstrained access
@@ -2002,7 +1952,7 @@ package body Accessibility is
   --  Flag used to temporarily disable a "True" result for tagged types.
   --  See comments further below for details.
 
-   --  Start of processing for Needs_Result_Accessibility_Level_Param
+   --  Start of processing for Needs_Result_Accessibility_Level
 
begin
   --  False if completion unavailable, which can happen when we are
@@ -2078,7 +2028,7 @@ package body Accessibility is
   else
  return False;
   end if;
-   end Needs_Result_Accessibility_Level_Param;
+   end Needs_Result_Accessibility_Level;
 
--
-- Prefix_With_Safe_Accessibility_Level --
diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads
index 731fea125f4..000e9b6e1e4 100644
--- a/gcc/ada/accessibility.ads
+++ b/gcc/ada/accessibility.ads
@@ -197,15 +197,6 @@ package Accessibility is
--  prefix is an aliased formal of Scop and that Scop returns an anonymous
--  access type. See RM 3.10.2 for more details.
 
-   function Needs_Result_Accessibility_Extra_Formal
- (Func_Id : Entity_Id) return Boolean;
-   --  Ada 2012 (AI05-0234): Return True if the functio

[COMMITTED] ada: Assertion failure on expansion of record with invariant

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

gcc/ada/

* exp_util.adb (Process_Record_Component): Adjust assertion on the
availablity of the invariant procedure; required because the
invariant procedure is built by the expander, and hence it is not
available compiling generic units or when the sources have errors,
since expansion is then disabled.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_util.adb | 12 ++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0dafa1cd6be..5cfadc5245e 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3324,7 +3324,13 @@ package body Exp_Util is
   --  if it has invariants of its own or inherits class-wide
   --  invariants from parent or interface types.
 
-  pragma Assert (Present (Proc_Id));
+  --  However, given that the invariant procedure is built by
+  --  the expander, it is not available compiling generic units
+  --  or when the sources have errors, since expansion is then
+  --  disabled.
+
+  pragma Assert (Present (Proc_Id)
+or else not Expander_Active);
 
   --  Generate:
   --Invariant (T (_object).);
@@ -,7 +3339,9 @@ package body Exp_Util is
   --  assertions are disabled or Assertion_Policy Ignore is in
   --  effect.
 
-  if not Has_Null_Body (Proc_Id) then
+  if Present (Proc_Id)
+and then not Has_Null_Body (Proc_Id)
+  then
  Append_New_To (Comp_Checks,
Make_Procedure_Call_Statement (Loc,
  Name   =>
-- 
2.40.0

[COMMITTED] ada: Assertion failure on calculation of Large_Max_Size_Mutable

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

gcc/ada/

* sem_util.adb (Large_Max_Size_Mutable): Protect access to
attribute Is_Array_Type.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_util.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3229f4e9dd2..cc9dcb30b18 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -22580,7 +22580,9 @@ package body Sem_Util is
  Ityp : Entity_Id;
 
   begin
- if Is_Array_Type (Comp_Type) then
+ if Present (Comp_Type)
+   and then Is_Array_Type (Comp_Type)
+ then
 Indx := First_Index (Comp_Type);
 
 while Present (Indx) loop
-- 
2.40.0

[COMMITTED] ada: Fix late finalization for function call in delta aggregate

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The problem occurs at library level because the temporary created for the
function call lives in the elaboration routine but is finalized only when
the package itself is.

It turns out that there is no need for this temporary, since the expansion
of delta aggregates already creates a (properly finalized) temporary.

gcc/ada/

* exp_ch6.adb (Expand_Ctrl_Function_Call): Also do nothing for the
expression of a delta aggregate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch6.adb | 8 ++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 0d1f1fb1c3b..da1c9e66102 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5424,9 +5424,13 @@ package body Exp_Ch6 is
   --  object, then no need to copy/readjust/finalize, we can initialize it
   --  in place. However, if the call returns on the secondary stack, then
   --  we need the expansion because we'll be renaming the temporary as the
-  --  (permanent) object.
+  --  (permanent) object. We also apply it in the case of the expression of
+  --  a delta aggregate, since it is used only to initialize a temporary.
 
-  if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then
+  if Nkind (Par) in N_Object_Declaration | N_Delta_Aggregate
+and then Expression (Par) = N
+and then not Use_Sec_Stack
+  then
  return;
   end if;
 
-- 
2.40.0

[COMMITTED] ada: Improve detection of deactivated code for warnings with -gnatwt

[Marc Poulhiès via Gcc-patches]

From: Yannick Moy 

Switch -gnatwt is used in GNAT to track deleted code. It can be emitted
by GNAT on code that is intentionally deactivated for a given configuration.
The current test to suppress spurious warnings is not complex enough to
detect all such cases. Now improved, by using the same test as used in
GNATprove to suppress warnings related to a "statically disabled condition
which evaluates to a given value", as described in SPARK UG 7.3.2.

gcc/ada/

* exp_util.adb (Is_Statically_Disabled): New function to detect a
"statically disabled condition which evaluates to a given value",
as described in SPARK UG 7.3.2.
(Kill_Dead_Code): Call the new function Is_Statically_Disabled for
conditions of if statements.
* exp_util.ads (Is_Statically_Disabled): New function spec.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_util.adb | 159 ---
 gcc/ada/exp_util.ads |  17 +
 2 files changed, 167 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5cfadc5245e..b2542d4ae59 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -30,7 +30,6 @@ with Checks; use Checks;
 with Debug;  use Debug;
 with Einfo;  use Einfo;
 with Einfo.Entities; use Einfo.Entities;
-with Einfo.Utils;use Einfo.Utils;
 with Elists; use Elists;
 with Errout; use Errout;
 with Exp_Aggr;   use Exp_Aggr;
@@ -9401,6 +9400,135 @@ package body Exp_Util is
 and then Has_Controlling_Result (Id);
end Is_Secondary_Stack_Thunk;
 
+   
+   -- Is_Statically_Disabled --
+   
+
+   function Is_Statically_Disabled
+ (N : Node_Id;
+  Value : Boolean;
+  Include_Valid : Boolean)
+  return Boolean
+   is
+  function Is_Discrete_Literal (N : Node_Id) return Boolean;
+  --  Returns whether N is an integer, character or enumeration literal
+
+  -
+  -- Is_Discrete_Literal --
+  -
+
+  function Is_Discrete_Literal (N : Node_Id) return Boolean is
+(Nkind (N) in N_Integer_Literal | N_Character_Literal
+  or else (Nkind (N) in N_Identifier | N_Expanded_Name
+and then Ekind (Entity (N)) = E_Enumeration_Literal));
+
+  Expr_N : constant Node_Id :=
+(if Is_Static_Expression (N)
+   and then Entity (N) in Standard_True | Standard_False
+   and then Is_Rewrite_Substitution (N)
+ then Original_Node (N)
+ else N);
+
+   --  Start of processing for Is_Statically_Disabled
+
+   begin
+  --  A "statically disabled" condition which evaluates to Value is either:
+
+  case Nkind (Expr_N) is
+
+ --  an AND or AND THEN operator when:
+ --  - Value is True and both operands are statically disabled
+ --conditions evaluated to True.
+ --  - Value is False and at least one operand is a statically disabled
+ --condition evaluated to False.
+
+ when N_Op_And | N_And_Then =>
+return
+  (if Value then
+ (Is_Statically_Disabled
+(Left_Opnd (Expr_N), Value, Include_Valid)
+  and then Is_Statically_Disabled
+(Right_Opnd (Expr_N), Value, Include_Valid))
+   else
+ (Is_Statically_Disabled
+(Left_Opnd (Expr_N), Value, Include_Valid)
+  or else Is_Statically_Disabled
+(Right_Opnd (Expr_N), Value, Include_Valid)));
+
+ --  an OR or OR ELSE operator when:
+ --  - Value is True and at least one operand is a statically disabled
+ --condition evaluated to True.
+ --  - Value is False and both operands are statically disabled
+ --conditions evaluated to False.
+
+ when N_Op_Or | N_Or_Else =>
+return
+  (if Value then
+ (Is_Statically_Disabled
+(Left_Opnd (Expr_N), Value, Include_Valid)
+  or else Is_Statically_Disabled
+(Right_Opnd (Expr_N), Value, Include_Valid))
+   else
+ (Is_Statically_Disabled
+(Left_Opnd (Expr_N), Value, Include_Valid)
+  and then Is_Statically_Disabled
+(Right_Opnd (Expr_N), Value, Include_Valid)));
+
+ --  a NOT operator when the right operand is a statically disabled
+ --  condition evaluated to the negation of Value.
+
+ when N_Op_Not =>
+return Is_Statically_Disabled
+  (Right_Opnd (Expr_N), not Value, Include_Valid);
+
+ --  a static constant when it is of a boolean type with aspect
+ --  Warnings Off.
+
+ when N_Identifier | N_Expanded_Name =>
+return Is_Stat

[COMMITTED] ada: Assertion failure on for-of loop iterating on selected component

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

gcc/ada/

* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): Protect
access to Entity attribute and add missing code to check function
selector in a prefix form call.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_util.adb | 9 +++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 35ec296ab93..3229f4e9dd2 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16509,8 +16509,13 @@ package body Sem_Util is
 --  False (it could be a function selector in a prefix form call
 --  occurring in an iterator specification).
 
-if Ekind (Entity (Selector_Name (Object))) not in
- E_Component | E_Discriminant
+if (Present (Entity (Selector_Name (Object)))
+  and then Ekind (Entity (Selector_Name (Object))) not in
+ E_Component | E_Discriminant)
+  or else
+(Inside_A_Generic
+   and then Nkind (Parent (Selector_Name (Object)))
+  = N_Function_Call)
 then
return False;
 end if;
-- 
2.40.0

[COMMITTED] ada: Fix premature finalization in loop over limited iterable container

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

This happens when the iterable container is obtained as the result of a
call to a function that is a subprogram parameter of a generic construct.

gcc/ada/

* exp_util.adb (Initialized_By_Aliased_BIP_Func_Call): Make the name
matching more robust.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_util.adb | 88 
 1 file changed, 48 insertions(+), 40 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a4b5ec366f3..0dafa1cd6be 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8399,65 +8399,73 @@ package body Exp_Util is
 
  Call := Unqual_Conv (Call);
 
+ --  We search for a formal with a matching suffix. We can't search
+ --  for the full name, because of the code at the end of Sem_Ch6.-
+ --  Create_Extra_Formals, which copies the Extra_Formals over to
+ --  the Alias of an instance, which will cause the formals to have
+ --  "incorrect" names. See also Exp_Ch6.Build_In_Place_Formal.
+
  if Is_Build_In_Place_Function_Call (Call) then
 declare
Caller_Allocation_Val : constant Uint :=
  UI_From_Int (BIP_Allocation_Form'Pos (Caller_Allocation));
+   Access_Suffix : constant String :=
+ BIP_Formal_Suffix (BIP_Object_Access);
+   Alloc_Suffix  : constant String :=
+ BIP_Formal_Suffix (BIP_Alloc_Form);
+
+   function Has_Suffix (Name, Suffix : String) return Boolean;
+   --  Return True if Name has suffix Suffix
+
+   
+   -- Has_Suffix --
+   
+
+   function Has_Suffix (Name, Suffix : String) return Boolean is
+  Len : constant Natural := Suffix'Length;
+
+   begin
+  return Name'Length > Len
+and then Name (Name'Last - Len + 1 .. Name'Last) = Suffix;
+   end Has_Suffix;
 
-   Access_Nam : Name_Id := No_Name;
Access_OK  : Boolean := False;
-   Actual : Node_Id;
-   Alloc_Nam  : Name_Id := No_Name;
Alloc_OK   : Boolean := True;
-   Formal : Node_Id;
-   Func_Id: Entity_Id;
Param  : Node_Id;
 
 begin
--  Examine all parameter associations of the function call
 
Param := First (Parameter_Associations (Call));
+
while Present (Param) loop
   if Nkind (Param) = N_Parameter_Association
 and then Nkind (Selector_Name (Param)) = N_Identifier
   then
- Actual := Explicit_Actual_Parameter (Param);
- Formal := Selector_Name (Param);
-
- --  Construct the names of formals BIPaccess and BIPalloc
- --  using the function name retrieved from an arbitrary
- --  formal.
-
- if Access_Nam = No_Name
-   and then Alloc_Nam = No_Name
-   and then Present (Entity (Formal))
- then
-Func_Id := Scope (Entity (Formal));
-
-Access_Nam :=
-  New_External_Name (Chars (Func_Id),
-BIP_Formal_Suffix (BIP_Object_Access));
-
-Alloc_Nam :=
-  New_External_Name (Chars (Func_Id),
-BIP_Formal_Suffix (BIP_Alloc_Form));
- end if;
+ declare
+Actual : constant Node_Id
+  := Explicit_Actual_Parameter (Param);
+Formal : constant Node_Id
+  := Selector_Name (Param);
+Name   : constant String
+  := Get_Name_String (Chars (Formal));
 
- --  A nonnull BIPaccess has been found
+ begin
+--  A nonnull BIPaccess has been found
 
- if Chars (Formal) = Access_Nam
-   and then Nkind (Actual) /= N_Null
- then
-Access_OK := True;
- end if;
+if Has_Suffix (Name, Access_Suffix)
+  and then Nkind (Actual) /= N_Null
+then
+   Access_OK := True;
 
- --  A BIPalloc has been found
+--  A BIPalloc has been found
 
- if Chars (Formal) = Alloc_Nam
-   and then Nkind (Actual) = N_Integer_Literal
- then
-Alloc_OK := Intval (Actual) = Caller_Allocati

[COMMITTED] ada: Assertion failure adding extra formals to late overriding subp.

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

gcc/ada/

* sem_ch6.adb (Parent_Subprogram): Complete assertion.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch6.adb | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 297371a2c16..612a9e97221 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8789,7 +8789,8 @@ package body Sem_Ch6 is
  and then Has_Controlling_Result (Subp_Id))
or else Has_Suffix (Ovr_E, 'P')
or else Is_RACW_Stub_Type
- (Find_Dispatching_Type (Subp_Id)));
+ (Find_Dispatching_Type (Subp_Id))
+   or else No (Overridden_Operation (Ovr_E)));
 
if Present (Overridden_Operation (Ovr_E)) then
   Ovr_E := Overridden_Operation (Ovr_E);
-- 
2.40.0

Re: [PING][PATCH] LoongArch: initial ada support on linux

[Marc Poulhiès via Gcc-patches]

Yujie Yang  writes:
> Hi Marc,
>
> Thank you for the review!
>
> We added -gnatea and -gnatez to CC1_SPECS for correct multilib handling,
> and I believe this is currently specific to LoongArch.
>
> LoongArch relies on the GCC driver (via self_specs rules) to generate a
> canonicalized tuple of parameters that identifies the current target (ISA/ABI)
> configuration, including the "-mabi=" option that corresponds to the selected
> multilib variant.  Even if "-mabi=" itself is not given explicitly to gcc, it
> may be fed to the compiler propers with values other than the default ABI.
>
> For GNAT on LoongArch, it is necessary that -mabi= generated by driver
> self-specs gets stored in the .ali file, otherwise the linker might
> hit the wrong multilib variant by assuming the default ABI.  Using
> -gnatea/-gnatez can mark the driver-generated "-mabi=" as "explicit",
> so it is sure to be found in "A"-records of the generated *.ali file.

Hello Yujie,

Thanks for the explanation!

Marc

[COMMITTED] ada: Elide the copy in extended returns for nonlimited by-reference types

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

gcc/ada/

* gcc-interface/trans.cc (gnat_to_gnu): Really test Storage_Pool on
the simple return statement.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/trans.cc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 5d93060c6d8..e99fbb4eb5e 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -8519,7 +8519,7 @@ gnat_to_gnu (Node_Id gnat_node)
   && ((Nkind (Parent (gnat_node)) == N_Attribute_Reference
&& lvalue_required_for_attribute_p (Parent (gnat_node)))
   || (Nkind (Parent (gnat_node)) == N_Simple_Return_Statement
-  && No (Storage_Pool (gnat_node)
+  && No (Storage_Pool (Parent (gnat_node))
 ;
 
   else if (TREE_TYPE (gnu_result) != gnu_result_type)
-- 
2.40.0

[COMMITTED] ada: Fix spurious warning emissions

[Marc Poulhiès via Gcc-patches]

From: Ronan Desplanques 

Before this patch, warnings handled by `Sem_Warn.Check_References` were
erroneously emitted in some cases. Here is an example of a program that,
when compiled with the `-gnatwu` switch, triggered the bug:

procedure Main is
   package T is
  A : Integer;
   end T;
begin
   T.A := 7;
end Main;

The following message was emitted:

   main.adb:3:07: warning: variable "A" is never read and never assigned 
[-gnatwu]

This patch mitigates the issue by restricting the cases in which
`Sem_Warn.Check_References` is called for package specifications.

Note that the recursive calls in `Sem_Warn.Check_References` can be used
to convince oneself that this patch does not remove legitimate warnings
for non-library-level package specifications.

gcc/ada/

* sem_ch7.adb (Analyze_Package_Declaration): Restrict calls to
`Sem_Warn.Check_References` and adjust comment accordingly.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch7.adb | 17 +++--
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index ecb4bbe3e56..1a49a53ad63 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1267,12 +1267,17 @@ package body Sem_Ch7 is
Is_Main_Unit => Parent (N) = Cunit (Main_Unit));
  end if;
 
- --  Warn about references to unset objects, which is straightforward
- --  for packages with no bodies. For packages with bodies this is more
- --  complicated, because some of the objects might be set between spec
- --  and body elaboration, in nested or child packages, etc.
-
- Check_References (Id);
+ --  For package declarations at the library level, warn about
+ --  references to unset objects, which is straightforward for packages
+ --  with no bodies. For packages with bodies this is more complicated,
+ --  because some of the objects might be set between spec and body
+ --  elaboration, in nested or child packages, etc. Note that the
+ --  recursive calls in Check_References will handle nested package
+ --  specifications.
+
+ if Is_Library_Level_Entity (Id) then
+Check_References (Id);
+ end if;
   end if;
 
   --  Set Body_Required indication on the compilation unit node
-- 
2.40.0

[COMMITTED] ada: Support setting task affinity on QNX

[Marc Poulhiès via Gcc-patches]

From: Johannes Kliemann 

QNX does not support setting the thread affinity via a POSIX API.
This implementation uses QNX's native Thread_Ctl API to set the
thread affinity for Ada tasks.

gcc/ada/

* libgnarl/s-taprop__qnx.adb: Implement Set_Task_Affinity.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnarl/s-taprop__qnx.adb | 45 ++
 1 file changed, 40 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb 
b/gcc/ada/libgnarl/s-taprop__qnx.adb
index 13335ef4acd..423229854a8 100644
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ b/gcc/ada/libgnarl/s-taprop__qnx.adb
@@ -49,6 +49,7 @@ with System.Interrupt_Management;
 with System.OS_Constants;
 with System.OS_Primitives;
 with System.Task_Info;
+with System.Multiprocessors;
 
 with System.Soft_Links;
 --  We use System.Soft_Links instead of System.Tasking.Initialization
@@ -1317,12 +1318,46 @@ package body System.Task_Primitives.Operations is
---
 
procedure Set_Task_Affinity (T : ST.Task_Id) is
-  pragma Unreferenced (T);
-
+  use type Multiprocessors.CPU_Range;
+
+  function Thread_Ctl_Ext
+(Pid : pid_t;
+ Tid : Thread_Id;
+ Command : Interfaces.C.unsigned;
+ Runmask : Interfaces.C.size_t) return Interfaces.C.int
+  with
+Import, Convention => C, External_Name => "ThreadCtlExt";
+  --  Thread_Ctl_Ext is a generic thread control function in QNX.
+  --  It is defined locally because in the C API its second
+  --  argument is a void pointer that takes different actual
+  --  pointer types or values depending on the command. This
+  --  particular instance of this function only accepts the
+  --  NTO_TCTL_RUNMASK command. The void * pointer in the C
+  --  interface is interpreted as bitmask for this command.
+  --  In the binding size_t is used as an integer type that
+  --  always has the same size as a pointer.
+
+  NTO_TCTL_RUNMASK : constant := 4;
+  --  Command for Thread_Ctl. Using this command in Thread_Ctl
+  --  allows the caller to pass a bitmask that describes on
+  --  which CPU the current thread is allowed to run on.
+
+  Pid : constant pid_t := getpid;
+  Result  : Interfaces.C.int;
+  Runmask : Interfaces.C.size_t;
+  --  Each set bit in runmask represents a processor that the thread
+  --  can run on. If all bits are set to one the thread can run on any CPU.
begin
-  --  Setting task affinity is not supported by the underlying system
-
-  null;
+  if T.Common.Base_CPU = Multiprocessors.Not_A_Specific_CPU then
+ Runmask := Interfaces.C.size_t'Last;
+  else
+ Runmask :=
+   Interfaces.C.size_t
+ (2 ** Natural (T.Common.Base_CPU - Multiprocessors.CPU'First));
+  end if;
+  Result :=
+ Thread_Ctl_Ext (Pid, Get_Thread_Id (T), NTO_TCTL_RUNMASK, Runmask);
+  pragma Assert (Result = 0);
end Set_Task_Affinity;
 
 end System.Task_Primitives.Operations;
-- 
2.40.0

[COMMITTED] ada: building_executable_programs_with_gnat.rst: fix -gnatw.x index

[Marc Poulhiès via Gcc-patches]

From: Ghjuvan Lacambre 

The index for this paragraph was wrong.

gcc/ada/

* doc/gnat_ugn/building_executable_programs_with_gnat.rst: Fix
index.
* gnat_ugn.texi: Regenerate.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 .../doc/gnat_ugn/building_executable_programs_with_gnat.rst   | 2 +-
 gcc/ada/gnat_ugn.texi | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst 
b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 8e479679ec1..6c0d2b34a92 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -4095,7 +4095,7 @@ of the pragma in the :title:`GNAT_Reference_manual`).
   should not complain at you.
 
 
-.. index:: -gnatwm  (gcc)
+.. index:: -gnatw.x  (gcc)
 
 :switch:`-gnatw.x`
   *Activate warnings for No_Exception_Propagation mode.*
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 78f9b87a82e..7c5926eba64 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT User's Guide for Native Platforms , Jul 17, 2023
+GNAT User's Guide for Native Platforms , Aug 31, 2023
 
 AdaCore
 
@@ -12578,7 +12578,7 @@ you know what you are doing in writing the pragma, and 
it
 should not complain at you.
 @end table
 
-@geindex -gnatwm (gcc)
+@geindex -gnatw.x (gcc)
 
 
 @table @asis
-- 
2.40.0

[COMMITTED] ada: Remove redundant protection against empty list

[Marc Poulhiès via Gcc-patches]

From: Piotr Trojanek 

Calls to First on No_List intentionally return Empty, so explicit guards
against No_List are unnecessary. Code cleanup; semantics is unaffected.

gcc/ada/

* sem_type.adb (Interface_Present_In_Ancestor): Remove guard against no
list of interfaces; fix style in comments (trailing dots).

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_type.adb | 40 +++-
 1 file changed, 19 insertions(+), 21 deletions(-)

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 8579130cdac..40de2951e20 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2649,34 +2649,32 @@ package body Sem_Type is
   --  In case of concurrent types we can't use the Corresponding Record_Typ
   --  to look for the interface because it is built by the expander (and
   --  hence it is not always available). For this reason we traverse the
-  --  list of interfaces (available in the parent of the concurrent type)
+  --  list of interfaces (available in the parent of the concurrent type).
 
   if Is_Concurrent_Type (Target_Typ) then
- if Present (Interface_List (Parent (Target_Typ))) then
-declare
-   AI : Node_Id;
+ declare
+AI : Node_Id;
 
-begin
-   AI := First (Interface_List (Parent (Target_Typ)));
+ begin
+AI := First (Interface_List (Parent (Target_Typ)));
 
-   --  The progenitor itself may be a subtype of an interface type.
+--  The progenitor itself may be a subtype of an interface type
 
-   while Present (AI) loop
-  if Etype (AI) = Iface_Typ
-or else Base_Type (Etype (AI)) = Iface_Typ
-  then
- return True;
+while Present (AI) loop
+   if Etype (AI) = Iface_Typ
+ or else Base_Type (Etype (AI)) = Iface_Typ
+   then
+  return True;
 
-  elsif Present (Interfaces (Etype (AI)))
-and then Iface_Present_In_Ancestor (Etype (AI))
-  then
- return True;
-  end if;
+   elsif Present (Interfaces (Etype (AI)))
+ and then Iface_Present_In_Ancestor (Etype (AI))
+   then
+  return True;
+   end if;
 
-  Next (AI);
-   end loop;
-end;
- end if;
+   Next (AI);
+end loop;
+ end;
 
  return False;
   end if;
-- 
2.40.0

[COMMITTED] ada: Fix problematic secondary stack management in protected entry

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The secondary stack mark goes formally out of scope before the finalizer
reads it to reclaim the storage.

gcc/ada/

* exp_ch9.adb (Build_Protected_Entry): Move the At_End procedure
from the entry body to the inner block statement.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch9.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index b0e3632b8c8..5dcd890c33c 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -3457,6 +3457,7 @@ package body Exp_Ch9 is
   Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Corresponding_Spec (N)));
 
   Reset_Scopes_To (First (Bod_Stmts), Block_Id);
+  Set_At_End_Proc (First (Bod_Stmts), At_End_Proc (N));
 
   case Corresponding_Runtime_Package (Pid) is
  when System_Tasking_Protected_Objects_Entries =>
@@ -3553,7 +3554,6 @@ package body Exp_Ch9 is
  --  Establish link between subprogram body and source entry body
 
  Set_Corresponding_Entry_Body (Proc_Body, N);
- Set_At_End_Proc (Proc_Body, At_End_Proc (N));
 
  Reset_Scopes_To (Proc_Body, Protected_Body_Subprogram (Ent));
  return Proc_Body;
-- 
2.40.0

[COMMITTED] ada: Preserve capability validity in address arithmetic

[Marc Poulhiès via Gcc-patches]

From: Daniel King 

On CHERI targets where System.Address is a capability, arithmetic on
addresses should avoid converting to integers and instead use the
operations defined in System.Storage_Elements to perform the arithmetic
directly on the System.Address object. This preserves the capability's
validity throughout the calculation, ensuring that the resulting capability
can be dereferenced.

gcc/ada/

* libgnat/s-carsi8.adb: Use operations from
System.Storage_Elements for address arithmetic.
* libgnat/s-carun8.adb: Likewise
* libgnat/s-casi128.adb: Likewise
* libgnat/s-casi16.adb: Likewise
* libgnat/s-casi32.adb: Likewise
* libgnat/s-casi64.adb: Likewise
* libgnat/s-caun128.adb: Likewise
* libgnat/s-caun16.adb: Likewise
* libgnat/s-caun32.adb: Likewise
* libgnat/s-caun64.adb: Likewise
* libgnat/s-geveop.adb: Likewise

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-carsi8.adb  |  9 
 gcc/ada/libgnat/s-carun8.adb  |  9 
 gcc/ada/libgnat/s-casi128.adb |  9 
 gcc/ada/libgnat/s-casi16.adb  | 13 ++-
 gcc/ada/libgnat/s-casi32.adb  |  9 
 gcc/ada/libgnat/s-casi64.adb  |  9 
 gcc/ada/libgnat/s-caun128.adb |  9 
 gcc/ada/libgnat/s-caun16.adb  | 13 ++-
 gcc/ada/libgnat/s-caun32.adb  |  9 
 gcc/ada/libgnat/s-caun64.adb  |  9 
 gcc/ada/libgnat/s-geveop.adb  | 43 ++-
 11 files changed, 76 insertions(+), 65 deletions(-)

diff --git a/gcc/ada/libgnat/s-carsi8.adb b/gcc/ada/libgnat/s-carsi8.adb
index 839f157a2ee..3946d474dd9 100644
--- a/gcc/ada/libgnat/s-carsi8.adb
+++ b/gcc/ada/libgnat/s-carsi8.adb
@@ -30,6 +30,7 @@
 --
 
 with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements;   use System.Storage_Elements;
 
 with Ada.Unchecked_Conversion;
 
@@ -94,8 +95,8 @@ package body System.Compare_Array_Signed_8 is
  for J in 0 .. Words_To_Compare - 1 loop
 if LeftP (J) /= RightP (J) then
return Compare_Array_S8_Unaligned
-(AddA (Left,  Address (4 * J)),
- AddA (Right, Address (4 * J)),
+(Left  + Storage_Offset (4 * J),
+ Right + Storage_Offset (4 * J),
  4, 4);
 end if;
  end loop;
@@ -108,8 +109,8 @@ package body System.Compare_Array_Signed_8 is
  --* Words_To_Compare = Compare_Len / 4
  --* Bytes_Compared_As_Words = Words_To_Compare * 4
  return Compare_Array_S8_Unaligned
-  (AddA (Left,  Address (Bytes_Compared_As_Words)),
-   AddA (Right, Address (Bytes_Compared_As_Words)),
+(Left  + Storage_Offset (Bytes_Compared_As_Words),
+ Right + Storage_Offset (Bytes_Compared_As_Words),
Left_Len  - Bytes_Compared_As_Words,
Right_Len - Bytes_Compared_As_Words);
   end;
diff --git a/gcc/ada/libgnat/s-carun8.adb b/gcc/ada/libgnat/s-carun8.adb
index b20e4e1b922..e6938def56a 100644
--- a/gcc/ada/libgnat/s-carun8.adb
+++ b/gcc/ada/libgnat/s-carun8.adb
@@ -30,6 +30,7 @@
 --
 
 with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements;   use System.Storage_Elements;
 
 with Ada.Unchecked_Conversion;
 
@@ -93,8 +94,8 @@ package body System.Compare_Array_Unsigned_8 is
  for J in 0 .. Words_To_Compare - 1 loop
 if LeftP (J) /= RightP (J) then
return Compare_Array_U8_Unaligned
-(AddA (Left,  Address (4 * J)),
- AddA (Right, Address (4 * J)),
+(Left  + Storage_Offset (4 * J),
+ Right + Storage_Offset (4 * J),
  4, 4);
 end if;
  end loop;
@@ -107,8 +108,8 @@ package body System.Compare_Array_Unsigned_8 is
  --* Words_To_Compare = Compare_Len / 4
  --* Bytes_Compared_As_Words = Words_To_Compare * 4
  return Compare_Array_U8_Unaligned
-  (AddA (Left,  Address (Bytes_Compared_As_Words)),
-   AddA (Right, Address (Bytes_Compared_As_Words)),
+  (Left  + Storage_Offset (Bytes_Compared_As_Words),
+   Right + Storage_Offset (Bytes_Compared_As_Words),
Left_Len  - Bytes_Compared_As_Words,
Right_Len - Bytes_Compared_As_Words);
   end;
diff --git a/gcc/ada/libgnat/s-casi128.adb b/gcc/ada/libgnat/s-casi128.adb
index 2b0caac75b2..91569e1091d 100644
--- a/gcc/ada/libgnat/s-casi128.adb
+++ b/gcc/ada/libgnat/s-casi128.adb
@@ -30,6 +30,7 @@
 ---

[COMMITTED] ada: Add guard before querying the type for its interfaces

[Marc Poulhiès via Gcc-patches]

From: Piotr Trojanek 

Fix crash on illegal code, when routine Iface_Present_In_Ancestor is
called on the predefined String type and attempts to examine the list of
interfaces.

gcc/ada/

* sem_type.adb (Iface_Present_In_Ancestor): Only look at the list of
interfaces for types that allow it. The guard is a high-level equivalent
of the entity kinds listed in the preconditon of the Interfaces query.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_type.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index bbdcd5f24b8..8579130cdac 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2578,7 +2578,9 @@ package body Sem_Type is
  end if;
 
  loop
-if Present (Interfaces (E)) then
+if Is_Record_Type (E)
+  and then Present (Interfaces (E))
+then
Elmt := First_Elmt (Interfaces (E));
while Present (Elmt) loop
   AI := Node (Elmt);
-- 
2.40.0

[COMMITTED] ada: Fix DWARF for certain arrays

[Marc Poulhiès via Gcc-patches]

From: Tom Tromey 

An array whose index type is a nonstandard enum will be marked as
"packed", but should not emit DW_AT_bit_stride unless it is also
bit-packed.

gcc/ada/

* gcc-interface/decl.cc (gnat_to_gnu_entity): Set bit-packed for
constrained and unconstrained array types.
* gcc-interface/misc.cc (gnat_get_array_descr_info): Examine
BIT_PACKED_ARRAY_TYPE_P.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/decl.cc |  8 +++-
 gcc/ada/gcc-interface/misc.cc | 14 +++---
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index ae756b35fdb..0cf7d3cee60 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2388,6 +2388,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree 
gnu_expr, bool definition)
  = (Is_Packed (gnat_entity)
 || Is_Packed_Array_Impl_Type (gnat_entity));
 
+   TYPE_BIT_PACKED_ARRAY_TYPE_P (tem)
+ = (Is_Packed_Array_Impl_Type (gnat_entity)
+? Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))
+: Is_Bit_Packed_Array (gnat_entity));
+
if (Treat_As_Volatile (gnat_entity))
  tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE);
 
@@ -2815,7 +2820,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, 
bool definition)
 
  TYPE_BIT_PACKED_ARRAY_TYPE_P (gnu_type)
= (Is_Packed_Array_Impl_Type (gnat_entity)
-  && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
+  ? Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))
+  : Is_Bit_Packed_Array (gnat_entity));
 
  /* If the maximum size doesn't overflow, use it.  */
  if (gnu_max_size
diff --git a/gcc/ada/gcc-interface/misc.cc b/gcc/ada/gcc-interface/misc.cc
index 30319ae58b1..3b21bf5b43a 100644
--- a/gcc/ada/gcc-interface/misc.cc
+++ b/gcc/ada/gcc-interface/misc.cc
@@ -774,7 +774,7 @@ gnat_get_array_descr_info (const_tree const_type,
 {
   tree type = const_cast (const_type);
   tree first_dimen, dimen;
-  bool is_packed_array, is_array;
+  bool is_bit_packed_array, is_array;
   int i;
 
   /* Temporaries created in the first pass and used in the second one for thin
@@ -784,15 +784,15 @@ gnat_get_array_descr_info (const_tree const_type,
   tree thinptr_template_expr = NULL_TREE;
   tree thinptr_bound_field = NULL_TREE;
 
-  /* If we have an implementation type for a packed array, get the orignial
+  /* If we have an implementation type for a packed array, get the original
  array type.  */
   if (TYPE_IMPL_PACKED_ARRAY_P (type) && TYPE_ORIGINAL_PACKED_ARRAY (type))
 {
+  is_bit_packed_array = BIT_PACKED_ARRAY_TYPE_P (type);
   type = TYPE_ORIGINAL_PACKED_ARRAY (type);
-  is_packed_array = true;
 }
   else
-is_packed_array = false;
+is_bit_packed_array = false;
 
   /* First pass: gather all information about this array except everything
  related to dimensions.  */
@@ -850,8 +850,8 @@ gnat_get_array_descr_info (const_tree const_type,
  order, so our view here has reversed dimensions.  */
   const bool convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen);
 
-  if (TYPE_PACKED (first_dimen))
-is_packed_array = true;
+  if (BIT_PACKED_ARRAY_TYPE_P (first_dimen))
+is_bit_packed_array = true;
 
   /* ??? For row major ordering, we probably want to emit nothing and
  instead specify it as the default in Dw_TAG_compile_unit.  */
@@ -975,7 +975,7 @@ gnat_get_array_descr_info (const_tree const_type,
   /* We need to specify a bit stride when it does not correspond to the
 natural size of the contained elements.  ??? Note that we do not
 support packed records and nested packed arrays.  */
-  else if (is_packed_array)
+  else if (is_bit_packed_array)
{
  info->stride = get_array_bit_stride (info->element_type);
  info->stride_in_bits = true;
-- 
2.40.0

[COMMITTED] ada: Remove TBC comment, no more needed

[Marc Poulhiès via Gcc-patches]

From: Liaiss Merzougue 

gcc/ada/

* libgnat/s-imguti.adb: Remove comment.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-imguti.adb | 1 -
 1 file changed, 1 deletion(-)

diff --git a/gcc/ada/libgnat/s-imguti.adb b/gcc/ada/libgnat/s-imguti.adb
index 2e69e630c8a..4b9e27a7d8f 100644
--- a/gcc/ada/libgnat/s-imguti.adb
+++ b/gcc/ada/libgnat/s-imguti.adb
@@ -231,7 +231,6 @@ package body System.Img_Util is
   begin
  pragma Assert (S >= Digs'First and E <= Digs'Last);
  --  S and E should be in the Digs array range
- --  TBC: Analysis should be completed
  for J in S .. E loop
 Set (Digs (J));
  end loop;
-- 
2.40.0

[COMMITTED] ada: Fix internal error on instantiation with private component type

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

First, this fixes an internal error on the instantiation of a nested generic
package taking an array type whose component type is a private type declared
in the parent package as formal type parameter. In the body of the instance,
the full view of the private type is visible and must be restored by means
of the Check_Generic_Actuals mechanism.

Second, this fixes the same internal error in the case where the component
type itself is an array type whose component type is a private type declared
in the parent package, i.e. when the formal type parameter is an array of
array type, by naturally extending the Has_Secondary_Private_View mechanism
to the array of array case.

gcc/ada/

* sem_ch12.adb (Component_Type_For_Private_View): New function.
(Check_Generic_Actuals): For an actual type parameter, also check
its component type if it is an array type.
(Check_Private_View): Use Component_Type_For_Private_View in the
case of an array type.
(Instantiate_Type): Likewise.
(Save_Global_References.Set_Global_Type): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch12.adb | 54 +++-
 1 file changed, 48 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 61e0ec47392..c264f2a8283 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -582,6 +582,13 @@ package body Sem_Ch12 is
--  Recurse on an actual that is a formal package whose declaration has
--  a box.
 
+   function Component_Type_For_Private_View (T : Entity_Id) return Entity_Id;
+   --  Return the component type of array type T, with the following addition:
+   --  if this component type itself is an array type which has not been first
+   --  declared as private, then recurse on it. This makes it possible to deal
+   --  with arrays of arrays the same way as multi-dimensional arrays in the
+   --  mechanism handling private views.
+
function Contains_Instance_Of
  (Inner : Entity_Id;
   Outer : Entity_Id;
@@ -7084,10 +7091,27 @@ package body Sem_Ch12 is
and then Scope (Etype (E)) /= Instance
and then Is_Entity_Name (Subtype_Indication (Parent (E)))
  then
---  Restore the proper view of the actual from the information
---  saved earlier by Instantiate_Type.
+declare
+   Indic : constant Node_Id := Subtype_Indication (Parent (E));
+
+begin
+   --  Restore the proper view of the actual from the information
+   --  saved earlier by Instantiate_Type.
+
+   Check_Private_View (Indic);
 
-Check_Private_View (Subtype_Indication (Parent (E)));
+   --  If this view is an array type, check its component type.
+   --  This handles the case of an array type whose component
+   --  type is private, used as the actual in an instantiation
+   --  of a generic construct declared in the same package as
+   --  the component type and taking an array type with this
+   --  component type as formal type parameter.
+
+   if Is_Array_Type (Etype (Indic)) then
+  Check_Actual_Type
+(Component_Type_For_Private_View (Etype (Indic)));
+   end if;
+end;
 
 --  If the actual is itself the formal of a parent instance,
 --  then also restore the proper view of its actual and so on.
@@ -7759,7 +7783,8 @@ package body Sem_Ch12 is
 
 elsif Is_Array_Type (Typ) then
Check_Private_Type
- (Component_Type (Typ), Has_Secondary_Private_View (N));
+ (Component_Type_For_Private_View (Typ),
+  Has_Secondary_Private_View (N));
 
 elsif (Is_Record_Type (Typ) or else Is_Concurrent_Type (Typ))
   and then Has_Discriminants (Typ)
@@ -7821,6 +7846,21 @@ package body Sem_Ch12 is
   return Result;
end Check_Hidden_Primitives;
 
+   -
+   -- Component_Type_For_Private_View --
+   -
+
+   function Component_Type_For_Private_View (T : Entity_Id) return Entity_Id is
+  Typ : constant Entity_Id := Component_Type (T);
+
+   begin
+  if Is_Array_Type (Typ) and then not Has_Private_Declaration (Typ) then
+ return Component_Type_For_Private_View (Typ);
+  else
+ return Typ;
+  end if;
+   end Component_Type_For_Private_View;
+
--
-- Contains_Instance_Of --
--
@@ -14373,7 +14413,8 @@ package body Sem_Ch12 is
   elsif (Is_Access_Type (Act_T)
   and then Is_Private_Type (Designated_Type (Act_T)))
 or else (Is_Array_Type (Act_T)
-  and then Is_Private_Type (Component_Type (Act_T)))
+   

[COMMITTED] ada: Remove redundant guard against an empty list of interfaces

[Marc Poulhiès via Gcc-patches]

From: Piotr Trojanek 

Code cleanup; semantics is unaffected.

gcc/ada/

* sem_type.adb (Iface_Present_In_Ancestor): Remove guard for empty list
of interfaces; the following loop will work just fine without it.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_type.adb | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 00a64152df1..bbdcd5f24b8 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2578,9 +2578,7 @@ package body Sem_Type is
  end if;
 
  loop
-if Present (Interfaces (E))
-  and then not Is_Empty_Elmt_List (Interfaces (E))
-then
+if Present (Interfaces (E)) then
Elmt := First_Elmt (Interfaces (E));
while Present (Elmt) loop
   AI := Node (Elmt);
-- 
2.40.0

[COMMITTED] ada: Crash on creation of extra formals on type extension

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

The compiler blows up processing an overriding dispatching function
of a derived tagged type that returns a private tagged type that
has an access type discriminant.

gcc/ada/

* accessibility.ads (Needs_Result_Accessibility_Extra_Formal): New
subprogram.
* accessibility.adb (Needs_Result_Accessibility_Level_Param): New
subprogram.
(Needs_Result_Accessibility_Extra_Formal): New subprogram,
temporarily keep the previous behavior of the frontend.
* sem_ch6.adb (Create_Extra_Formals): Replace occurrences of
function Needs_Result_Accessibility_Level_Param by calls to
function Needs_Result_Accessibility_Extra_Formal.
(Extra_Formals_OK): Ditto.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/accessibility.adb | 54 +--
 gcc/ada/accessibility.ads | 12 -
 gcc/ada/sem_ch6.adb   |  8 +++---
 3 files changed, 67 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index bc897d1ef18..6b4ec5b9d24 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -56,6 +56,16 @@ with Tbuild; use Tbuild;
 
 package body Accessibility is
 
+   function Needs_Result_Accessibility_Level_Param
+ (Func_Id  : Entity_Id;
+  Func_Typ : Entity_Id) return Boolean;
+   --  Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and
+   --  Needs_Result_Accessibility_Level_Param. Return True if the function
+   --  needs an implicit parameter to identify the accessibility level of
+   --  the function result "determined by the point of call". Func_Typ is
+   --  the function return type; this function returns False if Func_Typ is
+   --  Empty.
+
---
-- Accessibility_Message --
---
@@ -1892,6 +1902,34 @@ package body Accessibility is
and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
end Is_Special_Aliased_Formal_Access;
 
+   -
+   -- Needs_Result_Accessibility_Extra_Formal --
+   -
+
+   function Needs_Result_Accessibility_Extra_Formal
+ (Func_Id : Entity_Id) return Boolean
+   is
+  Func_Typ : Entity_Id;
+
+   begin
+  if Present (Underlying_Type (Etype (Func_Id))) then
+ Func_Typ := Underlying_Type (Etype (Func_Id));
+
+  --  Case of a function returning a private type which is not completed
+  --  yet. The support for this case is required because this function is
+  --  called to create the extra formals of dispatching primitives, and
+  --  they may be frozen before we see the full-view of their returned
+  --  private type.
+
+  else
+ --  Temporarily restore previous behavior
+ --  Func_Typ := Etype (Func_Id);
+ Func_Typ := Empty;
+  end if;
+
+  return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
+   end Needs_Result_Accessibility_Extra_Formal;
+
--
-- Needs_Result_Accessibility_Level --
--
@@ -1901,6 +1939,18 @@ package body Accessibility is
is
   Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
 
+   begin
+  return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
+   end Needs_Result_Accessibility_Level;
+
+   
+   -- Needs_Result_Accessibility_Level_Param --
+   
+
+   function Needs_Result_Accessibility_Level_Param
+ (Func_Id  : Entity_Id;
+  Func_Typ : Entity_Id) return Boolean
+   is
   function Has_Unconstrained_Access_Discriminant_Component
 (Comp_Typ : Entity_Id) return Boolean;
   --  Returns True if any component of the type has an unconstrained access
@@ -1952,7 +2002,7 @@ package body Accessibility is
   --  Flag used to temporarily disable a "True" result for tagged types.
   --  See comments further below for details.
 
-   --  Start of processing for Needs_Result_Accessibility_Level
+   --  Start of processing for Needs_Result_Accessibility_Level_Param
 
begin
   --  False if completion unavailable, which can happen when we are
@@ -2028,7 +2078,7 @@ package body Accessibility is
   else
  return False;
   end if;
-   end Needs_Result_Accessibility_Level;
+   end Needs_Result_Accessibility_Level_Param;
 
--
-- Prefix_With_Safe_Accessibility_Level --
diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads
index e30c90ab6a7..731fea125f4 100644
--- a/gcc/ada/accessibility.ads
+++ b/gcc/ada/accessibility.ads
@@ -197,11 +197,21 @@ package Accessibility is
--  prefix is an aliased formal of Scop and that Scop returns an anonymous
--  access type. See RM 3.10.2 for more details.
 
+  

[COMMITTED] ada: Handle GNATcheck violations

[Marc Poulhiès via Gcc-patches]

From: Sheri Bernstein 

For the GNATcheck rule "Improper_Returns", either use pragma Annotate
to exempt the violation with the rationale "early returns for performance",
or refactor the code by replacing multiple returns by a single return
statement with a conditional expression; this is more readable and
maintainable, and also conformant with a Highly Recommended design principle
of ISO 26262-6.  For the GNATcheck rule "Discriminated_Records", use pragma
Annotate to exempt the violation with the rationale "only variant records
are disallowed".

gcc/ada/

* libgnarl/a-reatim.adb (Time_Of): Add pragma to exempt
Discriminated_Records.
* libgnat/s-imguti.adb (Round, Set_Decimal_Digits): Likewise.
* libgnat/s-multip.adb (Number_Of_CPUs): Likewise.
* libgnarl/s-tpopsp__posix-foreign.adb (Self): Refactor multiple
returns.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnarl/a-reatim.adb|  5 +
 gcc/ada/libgnarl/s-tpopsp__posix-foreign.adb | 10 --
 gcc/ada/libgnat/s-imguti.adb | 10 ++
 gcc/ada/libgnat/s-multip.adb |  5 +
 4 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/libgnarl/a-reatim.adb b/gcc/ada/libgnarl/a-reatim.adb
index 56a84789729..24a77311f9d 100644
--- a/gcc/ada/libgnarl/a-reatim.adb
+++ b/gcc/ada/libgnarl/a-reatim.adb
@@ -307,6 +307,9 @@ is
--  Start of processing for Time_Of
 
begin
+  pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+   "early returns for performance");
+
   --  If SC is so far out of range that there is no possibility of the
   --  addition of TS getting it back in range, raise an exception right
   --  away. That way we don't have to worry about SC values overflowing.
@@ -356,6 +359,8 @@ is
 Out_Of_Range;
  end if;
   end if;
+
+  pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Time_Of;
 
-
diff --git a/gcc/ada/libgnarl/s-tpopsp__posix-foreign.adb 
b/gcc/ada/libgnarl/s-tpopsp__posix-foreign.adb
index 4b3e200150d..ebf0f622db0 100644
--- a/gcc/ada/libgnarl/s-tpopsp__posix-foreign.adb
+++ b/gcc/ada/libgnarl/s-tpopsp__posix-foreign.adb
@@ -95,12 +95,10 @@ package body Specific is
   Result := pthread_getspecific (ATCB_Key);
 
   --  If the key value is Null then it is a non-Ada task
-
-  if Result /= System.Null_Address then
- return To_Task_Id (Result);
-  else
- return Register_Foreign_Thread;
-  end if;
+  return
+ (if Result /= System.Null_Address then To_Task_Id (Result)
+  else Register_Foreign_Thread
+ );
end Self;
 
 end Specific;
diff --git a/gcc/ada/libgnat/s-imguti.adb b/gcc/ada/libgnat/s-imguti.adb
index 4c8cf5f3295..2e69e630c8a 100644
--- a/gcc/ada/libgnat/s-imguti.adb
+++ b/gcc/ada/libgnat/s-imguti.adb
@@ -119,6 +119,9 @@ package body System.Img_Util is
  pragma Assert (Digs'First < Digs'Last);
 
   begin
+ pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+   "early returns for performance");
+
  --  Nothing to do if rounding past the last digit we have
 
  if N >= LD then
@@ -178,6 +181,8 @@ package body System.Img_Util is
Digits_Before_Point := Digits_Before_Point + 1;
 end if;
  end if;
+
+ pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
   end Round;
 
   -
@@ -246,6 +251,9 @@ package body System.Img_Util is
--  Start of processing for Set_Decimal_Digits
 
begin
+  pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+"early returns for performance");
+
   --  Case of exponent given
 
   if Exp > 0 then
@@ -398,6 +406,8 @@ package body System.Img_Util is
 end if;
  end if;
   end if;
+
+  pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Set_Decimal_Digits;
 

diff --git a/gcc/ada/libgnat/s-multip.adb b/gcc/ada/libgnat/s-multip.adb
index 372f1407dbf..96177f9fc41 100644
--- a/gcc/ada/libgnat/s-multip.adb
+++ b/gcc/ada/libgnat/s-multip.adb
@@ -36,6 +36,9 @@ package body System.Multiprocessors is
 
function Number_Of_CPUs return CPU is
begin
+  pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+   "early returns for performance");
+
   if CPU'Last = 1 then
  return 1;
   else
@@ -46,6 +49,8 @@ package body System.Multiprocessors is
 return CPU (Gnat_Number_Of_CPUs);
  end;
   end if;
+
+  pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Number_Of_CPUs;
 
 end System.Multiprocessors;
-- 
2.40.0

[COMMITTED] ada: Pass -msmp when linking for ppc-vx6 --RTS=rtp-smp

[Marc Poulhiès via Gcc-patches]

From: Alexandre Oliva 

gprbuild and gnatmake won't pass --RTS=rtp-smp to the compiler driver
for linking.  The flag was not used during linking: the .spec files
named as linker options were all we passed for the linker to get the
-L flags for lib_smp and lib.

There was a problem, though: although /lib_smp/ and /lib/ were to be
searched in this order, and the specs files did that correctly, the
compiler would search /lib/ first regardless, because
STARTFILE_PREFIX_SPEC said so, and specs files cannot override that.

With this patch, we make sure the rtp-smp runtime causes -msmp to be
added to the command line passed to the compiler driver for linking,
and a corresponding patch for the ppc-vxworks configuration makes the
GCC compiler driver use this flag to select /lib_smp/ rather than
/lib/.

gcc/ada/

* libgnat/system-vxworks-ppc-rtp-smp.ads: Add -msmp to
Linker_Options pragma.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads 
b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
index d8c498fac7f..e4b80a8415e 100644
--- a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
+++ b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
@@ -120,6 +120,7 @@ package System is
 
 private
 
+   pragma Linker_Options ("-msmp");
pragma Linker_Options ("--specs=vxworks-smp-ppc-link.spec");
pragma Linker_Options ("--specs=vxworks-ppc-link.spec");
--  Setup proper set of -L's for this configuration
-- 
2.40.0

[COMMITTED] ada: Fix crash on selected component lookup in generic instance

[Marc Poulhiès via Gcc-patches]

From: Bob Duff 

This patch fixes a compiler crash on selected component lookup in an instance
of a generic unit when the relevant type is an itype.

gcc/ada/

* sem_ch4.adb (Find_Component_In_Instance): Check that
Declaration_Node (Par) is not Empty, as it is for itypes.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch4.adb | 10 +++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 8543f0d578b..50ba6c9c847 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5212,10 +5212,14 @@ package body Sem_Ch4 is
 end if;
  end loop;
 
- if Present (Par) and then Is_Generic_Actual_Type (Par) then
-
---  Now look for component in ancestor types
+ --  If Par is a generic actual, look for component in ancestor types.
+ --  Skip this if we have no Declaration_Node, as is the case for
+ --  itypes.
 
+ if Present (Par)
+   and then Is_Generic_Actual_Type (Par)
+   and then Present (Declaration_Node (Par))
+ then
 Par := Generic_Parent_Type (Declaration_Node (Par));
 loop
Find_Component_In_Instance (Par);
-- 
2.40.0

[COMMITTED] ada: Spurious warning about negative modular literal

[Marc Poulhiès via Gcc-patches]

From: Steve Baird 

If -gnatw.m is enabled, the compiler generates a warning if a unary
minus operator of a modular type is applied to an integer literal.
This warning was being incorrectly generated in some cases where no integer
literal is present in the source code.

gcc/ada/

* sem_res.adb (Resolve_Unary_Op): In deciding whether to emit a
warning about a modular type's unary minus operator being applied
to an integer literal, ignore integer literals for which
Comes_From_Source is False.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_res.adb | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9755e4d14a6..c708d04fc32 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -12671,6 +12671,7 @@ package body Sem_Res is
   if Warn_On_Suspicious_Modulus_Value
 and then Nkind (N) = N_Op_Minus
 and then Nkind (R) = N_Integer_Literal
+and then Comes_From_Source (R)
 and then Is_Modular_Integer_Type (B_Typ)
 and then Nkind (Parent (N)) not in N_Qualified_Expression
  | N_Type_Conversion
-- 
2.40.0

[COMMITTED] ada: Crash on function returning empty Ada 2022 aggregate

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

The compiler crashes processing a function that returns an empty
aggregate when its returned type is a record type which defined
its container aggregate aspects.

gcc/ada/

* exp_aggr.adb (Expand_Container_Aggregate): Report warning on
infinite recursion if an empty container aggregate appears in the
return statement of its Empty function. Fix typo in comment.
* sem_aggr.adb (Resolve_Aggregate): Resolve Ada 2022 empty
aggregate that initializes a record type that has defined its
container aggregate aspects.
(Resolve_Iterated_Association): Protect access to attribute Etype.
* sem_ch13.adb (Resolve_Aspect_Aggregate): Fix typo in comment.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 23 ++-
 gcc/ada/sem_aggr.adb | 14 ++
 gcc/ada/sem_ch13.adb |  2 +-
 3 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cd5cc0b7669..cdca24b7d5d 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6917,6 +6917,10 @@ package body Exp_Aggr is
 
   Siz := Aggregate_Size;
 
+  -
+  --  Empty function --
+  -
+
   if Ekind (Entity (Empty_Subp)) = E_Function
 and then Present (First_Formal (Entity (Empty_Subp)))
   then
@@ -6984,7 +6988,7 @@ package body Exp_Aggr is
 
  Append (Init_Stat, Aggr_Code);
 
- --  Size is dynamic: Create declaration for object, and intitialize
+ --  Size is dynamic: Create declaration for object, and initialize
  --  with a call to the null container, or an assignment to it.
 
   else
@@ -7013,6 +7017,23 @@ package body Exp_Aggr is
  Append (Init_Stat, Aggr_Code);
   end if;
 
+  --  Report warning on infinite recursion if an empty container aggregate
+  --  appears in the return statement of its Empty function.
+
+  if Ekind (Entity (Empty_Subp)) = E_Function
+and then Nkind (Parent (N)) = N_Simple_Return_Statement
+and then Is_Empty_List (Expressions (N))
+and then Is_Empty_List (Component_Associations (N))
+and then Entity (Empty_Subp) = Current_Scope
+  then
+ Error_Msg_Warn := SPARK_Mode /= On;
+ Error_Msg_N
+   ("!empty aggregate returned by the empty function of a container"
+& " aggregate<<<", Parent (N));
+ Error_Msg_N
+   ("\this will result in infinite recursion??", Parent (N));
+  end if;
+
   ---
   --  Positional aggregate --
   ---
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 364217d03db..e929fea3bb6 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1065,6 +1065,19 @@ package body Sem_Aggr is
 
  Resolve_Container_Aggregate (N, Typ);
 
+  --  Check Ada 2022 empty aggregate [] initializing a record type that has
+  --  aspect aggregate; the empty aggregate will be expanded into a call to
+  --  the empty function specified in the aspect aggregate.
+
+  elsif Has_Aspect (Typ, Aspect_Aggregate)
+and then Ekind (Typ) = E_Record_Type
+and then Is_Homogeneous_Aggregate (N)
+and then Is_Empty_List (Expressions (N))
+and then Is_Empty_List (Component_Associations (N))
+and then Ada_Version >= Ada_2022
+  then
+ Resolve_Container_Aggregate (N, Typ);
+
   elsif Is_Record_Type (Typ) then
  Resolve_Record_Aggregate (N, Typ);
 
@@ -3328,6 +3341,7 @@ package body Sem_Aggr is
 
   if Present (Add_Unnamed_Subp)
 and then No (New_Indexed_Subp)
+and then Present (Etype (Add_Unnamed_Subp))
 and then Etype (Add_Unnamed_Subp) /= Any_Type
   then
  declare
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7cd0800a56c..f89135983cf 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -16470,7 +16470,7 @@ package body Sem_Ch13 is
  Op_Name := Chars (First (Choices (Assoc)));
 
  --  When verifying the consistency of aspects between the freeze point
- --  and the end of declarqtions, we use a copy which is not analyzed
+ --  and the end of declarations, we use a copy which is not analyzed
  --  yet, so do it now.
 
  Subp_Id := Expression (Assoc);
-- 
2.40.0

[COMMITTED] ada: Compiler hangs on invalid postcondition

[Marc Poulhiès via Gcc-patches]

From: Steve Baird 

In some cases involving an illegal reference to F'Result in
the postcondition for a function not named F, the compiler would
hang instead of correctly diagnosing the error.

gcc/ada/

* sem_attr.adb (Denote_Same_Function): Handle the case where
Has_Homonym (Pref_Id) returns True but Homonym (Pref_Id) returns
an empty result.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_attr.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e00addd0152..d03761b1e30 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5921,7 +5921,9 @@ package body Sem_Attr is
 --  When a qualified name is used for the prefix, homonyms may come
 --  before the current function in the homonym chain.
 
-elsif Has_Homonym (Pref_Id) then
+elsif Has_Homonym (Pref_Id)
+  and then Present (Homonym (Pref_Id))
+then
return Denote_Same_Function (Homonym (Pref_Id), Spec_Id);
 end if;
 
-- 
2.40.0

[COMMITTED] ada: Tweak comment about tasking corner case

[Marc Poulhiès via Gcc-patches]

From: Ronan Desplanques 

This patch adjusts a comment that could have misleadingly suggested
that a corner case related to tasks could not exist in Ada 2012 or
Ada 2022.

gcc/ada/

* libgnarl/s-tassta.adb: Tweak comment.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnarl/s-tassta.adb | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index 53633c9f3dc..5be6253a978 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -1615,8 +1615,8 @@ package body System.Tasking.Stages is
 
 --  Usually, C.Common.Activator = Self_ID implies C.Master_Of_Task
 --  = CM. The only case where C is pending activation by this
---  task, but the master of C is not CM is in Ada 2005, when C is
---  part of a return object of a build-in-place function.
+--  task, but the master of C is not CM is when C is part of a
+--  return object of a build-in-place function.
 
 pragma Assert (C.Common.State = Unactivated);
 
-- 
2.40.0

[COMMITTED] ada: Fix assertion failure on very peculiar enumeration type

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The compiler currently does not support the combination of a representation
clause on an enumeration type with a size clause whose value is greater than
the size of the largest machine scalar supported by the target.

Given that such a type would have little practical value, this change causes
the compiler to give a proper error message instead of aborting.

gcc/ada/

* freeze.adb (Freeze_Enumeration_Type): Give an error on a type with
both representation clause and too large size.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/freeze.adb | 14 ++
 1 file changed, 14 insertions(+)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 38aeb2456ff..0fc33a420c2 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -8023,6 +8023,20 @@ package body Freeze is
 
  Adjust_Esize_For_Alignment (Typ);
   end if;
+
+  --  Reject a very large size on a type with a non-standard representation
+  --  because Expand_Freeze_Enumeration_Type cannot deal with it.
+
+  if Has_Non_Standard_Rep (Typ)
+and then Known_Esize (Typ)
+and then Esize (Typ) > System_Max_Integer_Size
+  then
+ Error_Msg_N
+   ("enumeration type with representation clause too large", Typ);
+ Error_Msg_Uint_1 := UI_From_Int (System_Max_Integer_Size);
+ Error_Msg_N
+   ("\the size of such a type cannot exceed ^ bits", Typ);
+  end if;
end Freeze_Enumeration_Type;
 
---
-- 
2.40.0

[COMMITTED] ada: Add missing units to Makefile.rtl

[Marc Poulhiès via Gcc-patches]

From: Ronan Desplanques 

A previous change accidently removed a-cohama and a-cohase from
`Makefile.rtl`. This patch adds these units back

gcc/ada/

* Makefile.rtl: Add missing units.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/Makefile.rtl | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index be81b9d47f8..e404d43f0ff 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -137,6 +137,8 @@ GNATRTL_NONTASKING_OBJS= \
   a-coboho$(objext) \
   a-cobove$(objext) \
   a-cogeso$(objext) \
+  a-cohama$(objext) \
+  a-cohase$(objext) \
   a-cohata$(objext) \
   a-coinho$(objext) \
   a-coinve$(objext) \
-- 
2.40.0

[COMMITTED] ada: Remove GNATcheck violations

[Marc Poulhiès via Gcc-patches]

From: Sheri Bernstein 

Use pragma Annotate to exempt GNATcheck violations that are related
to proof code. Specifically, exempt rules "Metrics_LSLOC" and
"Metrics_Cyclomatic_Complexity" whose limits are exceeded due to
proof code, and exempt rule "Discriminated_Records" for a variant record
that is only used in proof code.

gcc/ada/

* libgnat/s-aridou.adb: Add pragma to exempt Metrics_LSLOC.
(Double_Divide): Add pragma to exempt
Metrics_Cyclomatic_Complexity.
(Scaled_Divide): Likewise.
* libgnat/s-vauspe.ads (Uns_Option): Add pragma to exempt
Discriminated_Records.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-aridou.adb | 11 +++
 gcc/ada/libgnat/s-vauspe.ads |  3 +++
 2 files changed, 14 insertions(+)

diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb
index beb56bfabe1..6bcce59cfeb 100644
--- a/gcc/ada/libgnat/s-aridou.adb
+++ b/gcc/ada/libgnat/s-aridou.adb
@@ -29,6 +29,9 @@
 --  --
 --
 
+pragma Annotate (Gnatcheck, Exempt_On, "Metrics_LSLOC",
+ "limit exceeded due to proof code");
+
 with Ada.Unchecked_Conversion;
 with System.SPARK.Cut_Operations; use System.SPARK.Cut_Operations;
 
@@ -814,6 +817,8 @@ is
-- Double_Divide --
---
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Metrics_Cyclomatic_Complexity",
+"limit exceeded due to proof code");
procedure Double_Divide
  (X, Y, Z : Double_Int;
   Q, R: out Double_Int;
@@ -1221,6 +1226,7 @@ is
 
   Prove_Signs;
end Double_Divide;
+   pragma Annotate (Gnatcheck, Exempt_Off, "Metrics_Cyclomatic_Complexity");
 
-
-- Le3 --
@@ -1899,6 +1905,8 @@ is
-- Scaled_Divide --
---
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Metrics_Cyclomatic_Complexity",
+"limit exceeded due to proof code");
procedure Scaled_Divide
  (X, Y, Z : Double_Int;
   Q, R: out Double_Int;
@@ -3317,6 +3325,7 @@ is
   Prove_Sign_R;
   Prove_Signs;
end Scaled_Divide;
+   pragma Annotate (Gnatcheck, Exempt_Off, "Metrics_Cyclomatic_Complexity");
 
--
-- Sub3 --
@@ -3658,3 +3667,5 @@ is
 
pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
 end System.Arith_Double;
+
+pragma Annotate (Gnatcheck, Exempt_Off, "Metrics_LSLOC");
diff --git a/gcc/ada/libgnat/s-vauspe.ads b/gcc/ada/libgnat/s-vauspe.ads
index a6f81d715c4..b276eed5105 100644
--- a/gcc/ada/libgnat/s-vauspe.ads
+++ b/gcc/ada/libgnat/s-vauspe.ads
@@ -68,6 +68,8 @@ is
 when others => raise Program_Error)
with Ghost;
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Discriminated_Records",
+"variant record only used in proof code");
type Uns_Option (Overflow : Boolean := False) is record
   case Overflow is
  when True =>
@@ -76,6 +78,7 @@ is
 Value : Uns := 0;
   end case;
end record;
+   pragma Annotate (Gnatcheck, Exempt_Off, "Discriminated_Records");
 
function Wrap_Option (Value : Uns) return Uns_Option is
  (Overflow => False, Value => Value);
-- 
2.40.0

[COMMITTED] ada: Enforce subtype conformance of interface primitives

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

gcc/ada/

* sem_ch3.adb (Add_Internal_Interface_Entities): Add missing
subtype-conformance check on primitives implementing interface
primitives.
(Error_Posted_In_Formals): New subprogram.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 105 
 1 file changed, 105 insertions(+)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 042ace01724..3262236dd14 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1688,6 +1688,31 @@ package body Sem_Ch3 is
-
 
procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id) is
+
+  function Error_Posted_In_Formals (Subp : Entity_Id) return Boolean;
+  --  Determine if an error has been posted in some formal of Subp.
+
+  -
+  -- Error_Posted_In_Formals --
+  -
+
+  function Error_Posted_In_Formals (Subp : Entity_Id) return Boolean is
+ Formal : Entity_Id := First_Formal (Subp);
+
+  begin
+ while Present (Formal) loop
+if Error_Posted (Formal) then
+   return True;
+end if;
+
+Next_Formal (Formal);
+ end loop;
+
+ return False;
+  end Error_Posted_In_Formals;
+
+  --  Local variables
+
   Elmt  : Elmt_Id;
   Iface : Entity_Id;
   Iface_Elmt: Elmt_Id;
@@ -1741,6 +1766,86 @@ package body Sem_Ch3 is
 
pragma Assert (Present (Prim));
 
+   --  Check subtype conformance; we skip this check if errors have
+   --  been reported in the primitive (or in the formals of the
+   --  primitive) because Find_Primitive_Covering_Interface relies
+   --  on the subprogram Type_Conformant to locate the primitive,
+   --  and reports errors if the formals don't match.
+
+   if not Error_Posted (Prim)
+ and then not Error_Posted_In_Formals (Prim)
+   then
+  declare
+ Alias_Prim : Entity_Id;
+ Alias_Typ  : Entity_Id;
+ Err_Loc: Node_Id := Empty;
+ Ret_Type   : Entity_Id;
+
+  begin
+ --  For inherited primitives, in case of reporting an
+ --  error, the error must be reported on this primitive
+ --  (i.e. in the name of its type declaration); otherwise
+ --  the error would be reported in the formal of the
+ --  alias primitive defined on its parent type.
+
+ if Nkind (Parent (Prim)) = N_Full_Type_Declaration then
+Err_Loc := Prim;
+ end if;
+
+ --  Check subtype conformance of procedures, functions
+ --  with matching return type, or functions not returning
+ --  interface types.
+
+ if Ekind (Prim) = E_Procedure
+   or else Etype (Iface_Prim) = Etype (Prim)
+   or else not Is_Interface (Etype (Iface_Prim))
+ then
+Check_Subtype_Conformant
+  (New_Id  => Prim,
+   Old_Id  => Iface_Prim,
+   Err_Loc => Err_Loc,
+   Skip_Controlling_Formals => True);
+
+ --  Check subtype conformance of functions returning an
+ --  interface type; temporarily force both entities to
+ --  return the same type. Required because subprogram
+ --  Subtype_Conformant does not handle this case.
+
+ else
+Ret_Type := Etype (Iface_Prim);
+Set_Etype (Iface_Prim, Etype (Prim));
+
+Check_Subtype_Conformant
+  (New_Id  => Prim,
+   Old_Id  => Iface_Prim,
+   Err_Loc => Err_Loc,
+   Skip_Controlling_Formals => True);
+
+Set_Etype (Iface_Prim, Ret_Type);
+ end if;
+
+ --  Complete the error when reported on inherited
+ --  primitives.
+
+ if Nkind (Parent (Prim)) = N_Full_Type_Declaration
+   and then (Error_Posted (Prim)
+   or else Error_Posted_In_Formals (Prim))
+   and then Present (Alias (Prim))
+ then
+Alias_Prim := Ultimate_Alias (Prim);
+Alias_Typ  := Find_Dispatching_Type (Alias_Prim);
+
+if Alias_Typ /= Tagged_Type
+  and

[COMMITTED] Revert "Adjust one Ada test"

[Marc Poulhiès via Gcc-patches]

This reverts commit d8dc61bb5ab99c3239ea93a37097f9419bee0211.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/testsuite/gnat.dg/unroll3.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/testsuite/gnat.dg/unroll3.adb 
b/gcc/testsuite/gnat.dg/unroll3.adb
index 86193d64681..3bd06e7de76 100644
--- a/gcc/testsuite/gnat.dg/unroll3.adb
+++ b/gcc/testsuite/gnat.dg/unroll3.adb
@@ -23,4 +23,4 @@ package body Unroll3 is
 
 end Unroll3;
 
--- { dg-final { scan-tree-dump-times "loop with 2 iterations completely 
unrolled" 2 "cunroll" } }
+-- { dg-final { scan-tree-dump-times "loop with 3 iterations completely 
unrolled" 2 "cunroll" } }
-- 
2.40.0

[COMMITED v4] mklog: handle Signed-off-by, minor cleanup

[Marc Poulhiès via Gcc-patches]

Consider Signed-off-by lines as part of the ending of the initial
commit to avoid having these in the middle of the log when the
changelog part is injected after.

This is particularly usefull with:

 $ git gcc-commit-mklog --amend -s

that can be used to create the changelog and add the Signed-off-by line.

Also applies most of the shellcheck suggestions on the
prepare-commit-msg hook.

contrib/ChangeLog:

* mklog.py: Leave SOB lines after changelog.
* prepare-commit-msg: Apply most shellcheck suggestions.

Signed-off-by: Marc Poulhiès 
---
 contrib/mklog.py   | 34 +-
 contrib/prepare-commit-msg | 20 ++--
 2 files changed, 39 insertions(+), 15 deletions(-)

diff --git a/contrib/mklog.py b/contrib/mklog.py
index 0abefcd9374..effe5aa1ca5 100755
--- a/contrib/mklog.py
+++ b/contrib/mklog.py
@@ -41,7 +41,34 @@ from unidiff import PatchSet
 
 LINE_LIMIT = 100
 TAB_WIDTH = 8
-CO_AUTHORED_BY_PREFIX = 'co-authored-by: '
+
+# Initial commit:
+#   +--+
+#   | gccrs: Some title|
+#   |  | This is the "start"
+#   | This is some text explaining the commit. |
+#   | There can be several lines.  |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+#
+# Results in:
+#   +--+
+#   | gccrs: Some title|
+#   |  |
+#   | This is some text explaining the commit. | This is the "start"
+#   | There can be several lines.  |
+#   |  |<--->
+#   | gcc/rust/ChangeLog:  |
+#   |  | This is the generated
+#   | * some_file (bla):   | ChangeLog part
+#   | (foo):   |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+
+# this regex matches the first line of the "end" in the initial commit message
+FIRST_LINE_OF_END_RE = re.compile('(?i)^(signed-off-by:|co-authored-by:|#)')
 
 pr_regex = re.compile(r'(\/(\/|\*)|[Cc*!])\s+(?PPR [a-z+-]+\/[0-9]+)')
 prnum_regex = re.compile(r'PR (?P[a-z+-]+)/(?P[0-9]+)')
@@ -330,10 +357,7 @@ def update_copyright(data):
 
 
 def skip_line_in_changelog(line):
-if line.lower().startswith(CO_AUTHORED_BY_PREFIX) or line.startswith('#'):
-return False
-return True
-
+return FIRST_LINE_OF_END_RE.match(line) == None
 
 if __name__ == '__main__':
 extra_args = os.getenv('GCC_MKLOG_ARGS')
diff --git a/contrib/prepare-commit-msg b/contrib/prepare-commit-msg
index 48c9dad3c6f..1e94706ba40 100755
--- a/contrib/prepare-commit-msg
+++ b/contrib/prepare-commit-msg
@@ -32,11 +32,11 @@ if ! [ -f "$COMMIT_MSG_FILE" ]; then exit 0; fi
 # Don't do anything unless requested to.
 if [ -z "$GCC_FORCE_MKLOG" ]; then exit 0; fi
 
-if [ -z "$COMMIT_SOURCE" ] || [ $COMMIT_SOURCE = template ]; then
+if [ -z "$COMMIT_SOURCE" ] || [ "$COMMIT_SOURCE" = template ]; then
 # No source or "template" means new commit.
 cmd="diff --cached"
 
-elif [ $COMMIT_SOURCE = message ]; then
+elif [ "$COMMIT_SOURCE" = message ]; then
 # "message" means -m; assume a new commit if there are any changes staged.
 if ! git diff --cached --quiet; then
cmd="diff --cached"
@@ -44,23 +44,23 @@ elif [ $COMMIT_SOURCE = message ]; then
cmd="diff --cached HEAD^"
 fi
 
-elif [ $COMMIT_SOURCE = commit ]; then
+elif [ "$COMMIT_SOURCE" = commit ]; then
 # The message of an existing commit.  If it's HEAD, assume --amend;
 # otherwise, assume a new commit with -C.
-if [ $SHA1 = HEAD ]; then
+if [ "$SHA1" = HEAD ]; then
cmd="diff --cached HEAD^"
if [ "$(git config gcc-config.mklog-hook-type)" = "smart-amend" ]; then
# Check if the existing message still describes the staged changes.
f=$(mktemp /tmp/git-commit.XX) || exit 1
-   git log -1 --pretty=email HEAD > $f
-   printf '\n---\n\n' >> $f
-   git $cmd >> $f
+   git log -1 --pretty=email HEAD > "$f"
+   printf '\n---\n\n' >> &q

[PATCH v3] mklog: handle Signed-off-by, minor cleanup

[Marc Poulhiès via Gcc-patches]

Richard Sandiford via Gcc-patches  writes:
>> +# this regex matches the first line of the "end" in the initial commit 
>> message
>> +FIRST_LINE_OF_END_RE = re.compile('(?i)^(signed-off-by|co-authored-by|#): ')
>
> The current code only requires an initial "#", rather than an initial "#: ".
> Is that a deliberate change?
>
> The patch LGTM apart from that.

Hello Richard,

Thanks for the review and sorry for the delayed answer as I was away the
past weeks. This issue was catched early this month
(https://github.com/Rust-GCC/gccrs/pull/2504), but I didn't want to send
something here before leaving. Here's a fixed patched.

Ok for master?

Thanks,
Marc

---
 contrib/mklog.py   | 34 +-
 contrib/prepare-commit-msg | 20 ++--
 2 files changed, 39 insertions(+), 15 deletions(-)

diff --git a/contrib/mklog.py b/contrib/mklog.py
index 26230b9b4f2..496780883fb 100755
--- a/contrib/mklog.py
+++ b/contrib/mklog.py
@@ -41,7 +41,34 @@ from unidiff import PatchSet
 
 LINE_LIMIT = 100
 TAB_WIDTH = 8
-CO_AUTHORED_BY_PREFIX = 'co-authored-by: '
+
+# Initial commit:
+#   +--+
+#   | gccrs: Some title|
+#   |  | This is the "start"
+#   | This is some text explaining the commit. |
+#   | There can be several lines.  |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+#
+# Results in:
+#   +--+
+#   | gccrs: Some title|
+#   |  |
+#   | This is some text explaining the commit. | This is the "start"
+#   | There can be several lines.  |
+#   |  |<--->
+#   | gcc/rust/ChangeLog:  |
+#   |  | This is the generated
+#   | * some_file (bla):   | ChangeLog part
+#   | (foo):   |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+
+# this regex matches the first line of the "end" in the initial commit message
+FIRST_LINE_OF_END_RE = re.compile('(?i)^(signed-off-by:|co-authored-by:|#) ')
 
 pr_regex = re.compile(r'(\/(\/|\*)|[Cc*!])\s+(?PPR [a-z+-]+\/[0-9]+)')
 prnum_regex = re.compile(r'PR (?P[a-z+-]+)/(?P[0-9]+)')
@@ -330,10 +357,7 @@ def update_copyright(data):
 
 
 def skip_line_in_changelog(line):
-if line.lower().startswith(CO_AUTHORED_BY_PREFIX) or line.startswith('#'):
-return False
-return True
-
+return FIRST_LINE_OF_END_RE.match(line) == None
 
 if __name__ == '__main__':
 extra_args = os.getenv('GCC_MKLOG_ARGS')
diff --git a/contrib/prepare-commit-msg b/contrib/prepare-commit-msg
index 48c9dad3c6f..1e94706ba40 100755
--- a/contrib/prepare-commit-msg
+++ b/contrib/prepare-commit-msg
@@ -32,11 +32,11 @@ if ! [ -f "$COMMIT_MSG_FILE" ]; then exit 0; fi
 # Don't do anything unless requested to.
 if [ -z "$GCC_FORCE_MKLOG" ]; then exit 0; fi
 
-if [ -z "$COMMIT_SOURCE" ] || [ $COMMIT_SOURCE = template ]; then
+if [ -z "$COMMIT_SOURCE" ] || [ "$COMMIT_SOURCE" = template ]; then
 # No source or "template" means new commit.
 cmd="diff --cached"
 
-elif [ $COMMIT_SOURCE = message ]; then
+elif [ "$COMMIT_SOURCE" = message ]; then
 # "message" means -m; assume a new commit if there are any changes staged.
 if ! git diff --cached --quiet; then
cmd="diff --cached"
@@ -44,23 +44,23 @@ elif [ $COMMIT_SOURCE = message ]; then
cmd="diff --cached HEAD^"
 fi
 
-elif [ $COMMIT_SOURCE = commit ]; then
+elif [ "$COMMIT_SOURCE" = commit ]; then
 # The message of an existing commit.  If it's HEAD, assume --amend;
 # otherwise, assume a new commit with -C.
-if [ $SHA1 = HEAD ]; then
+if [ "$SHA1" = HEAD ]; then
cmd="diff --cached HEAD^"
if [ "$(git config gcc-config.mklog-hook-type)" = "smart-amend" ]; then
# Check if the existing message still describes the staged changes.
f=$(mktemp /tmp/git-commit.XX) || exit 1
-   git log -1 --pretty=email HEAD > $f
-   printf '\n---\n\n' >> $f
-   git $cmd >> $f
+   git log -1 --pretty=email HEAD > "$f"
+   printf '\n---\n\n' >> "$f"
+   git $cmd >> "$f"
if contrib/gcc-changelog/git_email.py "$f" >/dev/null 2>&1; then
# Existing commit message is still OK for amended commit.
-   rm $f
+   rm "$f"
exit 0
fi

Re: [PING][PATCH] LoongArch: initial ada support on linux

[Marc Poulhiès via Gcc-patches]

Yang Yujie  writes:

Hello Yujie,

> gcc/ChangeLog:
>
>   * ada/Makefile.rtl: Add LoongArch support.
>   * ada/libgnarl/s-linux__loongarch.ads: New.
>   * ada/libgnat/system-linux-loongarch.ads: New.
>   * config/loongarch/loongarch.h: mark normalized options
>   passed from driver to gnat1 as explicit for multilib.
> ---
>  gcc/ada/Makefile.rtl   |  49 +++
>  gcc/ada/libgnarl/s-linux__loongarch.ads| 134 +++
>  gcc/ada/libgnat/system-linux-loongarch.ads | 145 +

The Ada part of the patch looks correct, thanks.

>  gcc/config/loongarch/loongarch.h   |   4 +-
>  4 files changed, 330 insertions(+), 2 deletions(-)
> diff --git a/gcc/config/loongarch/loongarch.h 
> b/gcc/config/loongarch/loongarch.h
> index f8167875646..9887a7ac630 100644
> --- a/gcc/config/loongarch/loongarch.h
> +++ b/gcc/config/loongarch/loongarch.h
> @@ -83,9 +83,9 @@ along with GCC; see the file COPYING3.  If not see
>  /* CC1_SPEC is the set of arguments to pass to the compiler proper.  */
>
>  #undef CC1_SPEC
> -#define CC1_SPEC "\
> +#define CC1_SPEC "%{,ada:-gnatea} %{m*} \
>  %{G*} \
> -%(subtarget_cc1_spec)"
> +%(subtarget_cc1_spec) %{,ada:-gnatez}"
>
>  /* Preprocessor specs.  */

This is outside of ada/ (so I don't have a say on it), but I'm curious
about why you need to use -gnatea/-gnatez here?

Thanks,
Marc

[COMMITTED] ada: Refactor multiple returns

[Marc Poulhiès via Gcc-patches]

From: Sheri Bernstein 

Replace multiple returns by a single return statement with a conditional
expression. This is more readable and maintainable, and also conformant with
a Highly Recommended design principle of ISO 26262-6.

gcc/ada/

* libgnat/s-parame__qnx.adb: Refactor multiple returns.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-parame__qnx.adb | 30 +++---
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/gcc/ada/libgnat/s-parame__qnx.adb 
b/gcc/ada/libgnat/s-parame__qnx.adb
index d9b46b6f795..8a7dfaf57d0 100644
--- a/gcc/ada/libgnat/s-parame__qnx.adb
+++ b/gcc/ada/libgnat/s-parame__qnx.adb
@@ -39,13 +39,11 @@ package body System.Parameters is
 
function Adjust_Storage_Size (Size : Size_Type) return Size_Type is
begin
-  if Size = Unspecified_Size then
- return Default_Stack_Size;
-  elsif Size < Minimum_Stack_Size then
- return Minimum_Stack_Size;
-  else
- return Size;
-  end if;
+  return
+ (if Size = Unspecified_Size then Default_Stack_Size
+  elsif Size < Minimum_Stack_Size then Minimum_Stack_Size
+  else Size
+ );
end Adjust_Storage_Size;
 

@@ -56,14 +54,16 @@ package body System.Parameters is
   Default_Stack_Size : constant Integer;
   pragma Import (C, Default_Stack_Size, "__gl_default_stack_size");
begin
-  if Default_Stack_Size = -1 then
- --  256K is the default stack size on aarch64 QNX
- return 256 * 1024;
-  elsif Size_Type (Default_Stack_Size) < Minimum_Stack_Size then
- return Minimum_Stack_Size;
-  else
- return Size_Type (Default_Stack_Size);
-  end if;
+  return
+ (if Default_Stack_Size = -1
+  then
+ (256 * 1024) --  256K is the default stack size on aarch64 QNX
+  elsif Size_Type (Default_Stack_Size) < Minimum_Stack_Size
+  then
+ Minimum_Stack_Size
+  else
+ Size_Type (Default_Stack_Size)
+ );
end Default_Stack_Size;
 

-- 
2.40.0

[COMMITTED] ada: Extend precondition of Interfaces.C.String.Value with Length

[Marc Poulhiès via Gcc-patches]

From: Piotr Trojanek 

The existing precondition guarded against exception Dereference_Error,
but not against Constraint_Error.

The RM rule B.3.1(36/3) only mentions Constraint_Error for the Value
function which returns char_array, but the one which returns String
has the same restriction, because it is equivalent to calling the
variant which returns char_array and then converted.

gcc/ada/

* libgnat/i-cstrin.ads (Value): Extend preconditions; adapt comment for
the package.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/i-cstrin.ads | 8 
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/libgnat/i-cstrin.ads b/gcc/ada/libgnat/i-cstrin.ads
index e486f03a585..9f1577f5e14 100644
--- a/gcc/ada/libgnat/i-cstrin.ads
+++ b/gcc/ada/libgnat/i-cstrin.ads
@@ -36,8 +36,8 @@
 --  Preconditions in this unit are meant for analysis only, not for run-time
 --  checking, so that the expected exceptions are raised. This is enforced by
 --  setting the corresponding assertion policy to Ignore. These preconditions
---  protect from Dereference_Error and Update_Error, but not from
---  Storage_Error.
+--  protect from Constraint_Error, Dereference_Error and Update_Error, but not
+--  from Storage_Error.
 
 pragma Assertion_Policy (Pre => Ignore);
 
@@ -95,7 +95,7 @@ is
  (Item   : chars_ptr;
   Length : size_t) return char_array
with
- Pre=> Item /= Null_Ptr,
+ Pre=> Item /= Null_Ptr and then Length /= 0,
  Global => (Input => C_Memory);
 
function Value (Item : chars_ptr) return String with
@@ -106,7 +106,7 @@ is
  (Item   : chars_ptr;
   Length : size_t) return String
with
- Pre=> Item /= Null_Ptr,
+ Pre=> Item /= Null_Ptr and then Length /= 0,
  Global => (Input => C_Memory);
 
function Strlen (Item : chars_ptr) return size_t with
-- 
2.40.0

[COMMITTED] ada: Crash in GNATprove due to wrong detection of inlining

[Marc Poulhiès via Gcc-patches]

From: Yannick Moy 

When a function is called in a predicate, it was not properly detected
as not always inlined in GNATprove mode, which led to crashes later during
analysis. Fixed now.

gcc/ada/

* sem_res.adb (Resolve_Call): Always call Cannot_Inline so that
subprogram called is marked as not always inlined.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_res.adb | 18 ++
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ac0c60f5f22..9755e4d14a6 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7330,30 +7330,32 @@ package body Sem_Res is
  or else Is_Invariant_Procedure (Current_Subprogram)
  or else Is_DIC_Procedure (Current_Subprogram))
then
-  if Present (Body_Id)
-and then Present (Body_To_Inline (Nam_Decl))
-  then
+  declare
+ Issue_Msg : constant Boolean :=
+   Present (Body_Id)
+ and then Present (Body_To_Inline (Nam_Decl));
+  begin
  if Is_Predicate_Function (Current_Subprogram) then
 Cannot_Inline
   ("cannot inline & (inside predicate)?",
-   N, Nam_UA);
+   N, Nam_UA, Suppress_Info => not Issue_Msg);
 
  elsif Is_Invariant_Procedure (Current_Subprogram) then
 Cannot_Inline
   ("cannot inline & (inside invariant)?",
-   N, Nam_UA);
+   N, Nam_UA, Suppress_Info => not Issue_Msg);
 
  elsif Is_DIC_Procedure (Current_Subprogram) then
 Cannot_Inline
 ("cannot inline & (inside Default_Initial_Condition)?",
- N, Nam_UA);
+ N, Nam_UA, Suppress_Info => not Issue_Msg);
 
  else
 Cannot_Inline
   ("cannot inline & (inside expression function)?",
-   N, Nam_UA);
+   N, Nam_UA, Suppress_Info => not Issue_Msg);
  end if;
-  end if;
+  end;
 
--  Cannot inline a call inside the definition of a record type,
--  typically inside the constraints of the type. Calls in
-- 
2.40.0

[COMMITTED] ada: Spurious error on class-wide preconditions

[Marc Poulhiès via Gcc-patches]

From: Javier Miranda 

The compiler reports an spurious error when a class-wide precondition
expression has a class-wide type conversion.

gcc/ada/

* sem_res.adb (Resolve_Type_Conversion): Do not warn on conversion
to class-wide type on internally build helpers of class-wide
preconditions.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_res.adb | 12 
 1 file changed, 12 insertions(+)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index d3a0192fb09..ac0c60f5f22 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -12455,6 +12455,18 @@ package body Sem_Res is
 elsif Orig_T = Base_Type (Standard_Long_Long_Integer) then
null;
 
+--  Do not warn on conversion to class-wide type on helpers of
+--  class-wide preconditions because in this context the warning
+--  would be spurious (since the class-wide precondition has been
+--  installed in the return statement of the helper, which has a
+--  class-wide formal type instead of a regular tagged type).
+
+elsif Is_Class_Wide_Type (Orig_T)
+  and then Is_Subprogram_Or_Generic_Subprogram (Current_Scope)
+  and then Present (Class_Preconditions_Subprogram (Current_Scope))
+then
+   null;
+
 --  Here we give the redundant conversion warning. If it is an
 --  entity, give the name of the entity in the message. If not,
 --  just mention the expression.
-- 
2.40.0

[COMMITTED] ada: Rewrite Set_Image_*_Unsigned routines to remove recursion.

[Marc Poulhiès via Gcc-patches]

From: Vasiliy Fofanov 

This rewriting removes algorithm inefficiencies due to unnecessary
recursion and copying. The new version has much smaller and statically known
stack requirements and is additionally up to 2x faster.

gcc/ada/

* libgnat/s-imageb.adb (Set_Image_Based_Unsigned): Rewritten.
* libgnat/s-imagew.adb (Set_Image_Width_Unsigned): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-imageb.adb | 71 --
 gcc/ada/libgnat/s-imagew.adb | 84 
 2 files changed, 55 insertions(+), 100 deletions(-)

diff --git a/gcc/ada/libgnat/s-imageb.adb b/gcc/ada/libgnat/s-imageb.adb
index 6aa311a13e5..037f15b58c7 100644
--- a/gcc/ada/libgnat/s-imageb.adb
+++ b/gcc/ada/libgnat/s-imageb.adb
@@ -88,68 +88,53 @@ package body System.Image_B is
   S : out String;
   P : in out Natural)
is
-  Start : constant Natural := P;
-  F, T  : Natural;
+  Start : constant Natural := P + 1;
   BU: constant Uns := Uns (B);
   Hex   : constant array
 (Uns range 0 .. 15) of Character := "0123456789ABCDEF";
 
-  procedure Set_Digits (T : Uns);
-  --  Set digits of absolute value of T
+  Nb_Digits : Natural := 1;
+  T : Uns := V;
 
-  
-  -- Set_Digits --
-  
+   begin
 
-  procedure Set_Digits (T : Uns) is
-  begin
- if T >= BU then
-Set_Digits (T / BU);
-P := P + 1;
-S (P) := Hex (T mod BU);
- else
-P := P + 1;
-S (P) := Hex (T);
- end if;
-  end Set_Digits;
+  --  First we compute the number of characters needed for representing
+  --  the number.
+  loop
+ T := T / BU;
+ exit when T = 0;
+ Nb_Digits := Nb_Digits + 1;
+  end loop;
 
-   --  Start of processing for Set_Image_Based_Unsigned
+  P := Start;
 
-   begin
+  --  Pad S with spaces up to W reduced by Nb_Digits plus extra 3-4
+  --  characters needed for displaying the base.
+  while P < Start + W - Nb_Digits - 3 - B / 10 loop
+ S (P) := ' ';
+ P := P + 1;
+  end loop;
 
   if B >= 10 then
- P := P + 1;
  S (P) := '1';
+ P := P + 1;
   end if;
 
+  S (P) := Hex (BU mod 10);
   P := P + 1;
-  S (P) := Character'Val (Character'Pos ('0') + B mod 10);
 
-  P := P + 1;
   S (P) := '#';
-
-  Set_Digits (V);
-
   P := P + 1;
-  S (P) := '#';
-
-  --  Add leading spaces if required by width parameter
-
-  if P - Start < W then
- F := P;
- P := Start + W;
- T := P;
 
- while F > Start loop
-S (T) := S (F);
-T := T - 1;
-F := F - 1;
- end loop;
+  --  We now populate digits from the end of the value to the beginning
+  T := V;
+  for J in reverse P .. P + Nb_Digits - 1 loop
+ S (J) := Hex (T mod BU);
+ T := T / BU;
+  end loop;
 
- for J in Start + 1 .. T loop
-S (J) := ' ';
- end loop;
-  end if;
+  P := P + Nb_Digits;
+  S (P) := '#';
 
end Set_Image_Based_Unsigned;
 
diff --git a/gcc/ada/libgnat/s-imagew.adb b/gcc/ada/libgnat/s-imagew.adb
index 00b63eb87d6..28ba37ced1e 100644
--- a/gcc/ada/libgnat/s-imagew.adb
+++ b/gcc/ada/libgnat/s-imagew.adb
@@ -86,66 +86,36 @@ package body System.Image_W is
   S : out String;
   P : in out Natural)
is
-  Start : constant Natural := P;
-  F, T  : Natural;
-
-  procedure Set_Digits (T : Uns);
-  --  Set digits of absolute value of T
-
-  
-  -- Set_Digits --
-  
-
-  procedure Set_Digits (T : Uns) is
-  begin
- if T >= 10 then
-Set_Digits (T / 10);
-pragma Assert (P >= (S'First - 1) and P < S'Last and
-   P < Natural'Last);
---  No check is done since, as documented in the specification,
---  the caller guarantees that S is long enough to hold the result.
-P := P + 1;
-S (P) := Character'Val (T mod 10 + Character'Pos ('0'));
-
- else
-pragma Assert (P >= (S'First - 1) and P < S'Last and
-   P < Natural'Last);
---  No check is done since, as documented in the specification,
---  the caller guarantees that S is long enough to hold the result.
-P := P + 1;
-S (P) := Character'Val (T + Character'Pos ('0'));
- end if;
-  end Set_Digits;
-
-   --  Start of processing for Set_Image_Width_Unsigned
+  Start : constant Natural := P + 1;
+  Nb_Digits : Natural := 1;
+  T : Uns := V;
 
begin
-  Set_Digits (V);
-
-  --  Add leading spaces if required by width parameter
-
-  if P - Start < W then
- F := P;
- P := P + (W - (P 

[COMMITTED] ada: Add pragma Annotate for GNATcheck exemptions

[Marc Poulhiès via Gcc-patches]

From: Sheri Bernstein 

Exempt the GNATcheck rule "Improper_Returns" with the rationale
"early returns for performance".

gcc/ada/

* libgnat/s-aridou.adb: Add pragma to exempt Improper_Returns.
* libgnat/s-atopri.adb (Lock_Free_Try_Write): Likewise.
* libgnat/s-bitops.adb (Bit_Eq): Likewise.
* libgnat/s-carsi8.adb: Likewise.
* libgnat/s-carun8.adb: Likewise.
* libgnat/s-casi16.adb: Likewise.
* libgnat/s-casi32.adb: Likewise.
* libgnat/s-casi64.adb: Likewise.
* libgnat/s-caun16.adb: Likewise.
* libgnat/s-caun32.adb: Likewise.
* libgnat/s-caun64.adb: Likewise.
* libgnat/s-exponn.adb: Likewise.
* libgnat/s-expont.adb: Likewise.
* libgnat/s-valspe.adb: Likewise.
* libgnat/s-vauspe.adb: Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-aridou.adb | 4 
 gcc/ada/libgnat/s-atopri.adb | 5 +
 gcc/ada/libgnat/s-bitops.adb | 5 +
 gcc/ada/libgnat/s-carsi8.adb | 4 
 gcc/ada/libgnat/s-carun8.adb | 4 
 gcc/ada/libgnat/s-casi16.adb | 4 
 gcc/ada/libgnat/s-casi32.adb | 4 
 gcc/ada/libgnat/s-casi64.adb | 4 
 gcc/ada/libgnat/s-caun16.adb | 4 
 gcc/ada/libgnat/s-caun32.adb | 4 
 gcc/ada/libgnat/s-caun64.adb | 4 
 gcc/ada/libgnat/s-exponn.adb | 5 +
 gcc/ada/libgnat/s-expont.adb | 5 +
 gcc/ada/libgnat/s-valspe.adb | 5 +
 gcc/ada/libgnat/s-vauspe.adb | 5 +
 15 files changed, 66 insertions(+)

diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb
index 2f1fbd55453..beb56bfabe1 100644
--- a/gcc/ada/libgnat/s-aridou.adb
+++ b/gcc/ada/libgnat/s-aridou.adb
@@ -90,6 +90,9 @@ is
  (On, "non-preelaborable call not allowed in preelaborated unit");
pragma Warnings (On, "non-static constant in preelaborated unit");
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+"early returns for performance");
+
---
-- Local Subprograms --
---
@@ -3653,4 +3656,5 @@ is
   end if;
end To_Pos_Int;
 
+   pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
 end System.Arith_Double;
diff --git a/gcc/ada/libgnat/s-atopri.adb b/gcc/ada/libgnat/s-atopri.adb
index 9e23fa0ac91..5fc2a123a71 100644
--- a/gcc/ada/libgnat/s-atopri.adb
+++ b/gcc/ada/libgnat/s-atopri.adb
@@ -59,6 +59,9 @@ package body System.Atomic_Primitives is
 new Atomic_Compare_Exchange (Atomic_Type);
 
begin
+  pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+   "early returns for performance");
+
   if Expected /= Desired then
  if Atomic_Type'Atomic_Always_Lock_Free then
 return My_Atomic_Compare_Exchange (Ptr, Expected'Address, Desired);
@@ -68,6 +71,8 @@ package body System.Atomic_Primitives is
   end if;
 
   return True;
+
+  pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Lock_Free_Try_Write;
 
 end System.Atomic_Primitives;
diff --git a/gcc/ada/libgnat/s-bitops.adb b/gcc/ada/libgnat/s-bitops.adb
index 30699d73175..acddd52892c 100644
--- a/gcc/ada/libgnat/s-bitops.adb
+++ b/gcc/ada/libgnat/s-bitops.adb
@@ -112,6 +112,9 @@ package body System.Bit_Ops is
   RightB : constant Bits := To_Bits (Right);
 
begin
+  pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+   "early returns for performance");
+
   if Llen /= Rlen then
  return False;
 
@@ -134,6 +137,8 @@ package body System.Bit_Ops is
 end if;
  end;
   end if;
+
+  pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Bit_Eq;
 
-
diff --git a/gcc/ada/libgnat/s-carsi8.adb b/gcc/ada/libgnat/s-carsi8.adb
index 807dceefc58..839f157a2ee 100644
--- a/gcc/ada/libgnat/s-carsi8.adb
+++ b/gcc/ada/libgnat/s-carsi8.adb
@@ -58,6 +58,9 @@ package body System.Compare_Array_Signed_8 is
function To_Big_Bytes is new
  Ada.Unchecked_Conversion (System.Address, Big_Bytes_Ptr);
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+"early returns for performance");
+
--
-- Compare_Array_S8 --
--
@@ -147,4 +150,5 @@ package body System.Compare_Array_Signed_8 is
   end if;
end Compare_Array_S8_Unaligned;
 
+   pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
 end System.Compare_Array_Signed_8;
diff --git a/gcc/ada/libgnat/s-carun8.adb b/gcc/ada/libgnat/s-carun8.adb
index b0f2d94bf8a..b20e4e1b922 100644
--- a/gcc/ada/libgnat/s-carun8.adb
+++ b/gcc/ada/libgnat/s-carun8.adb
@@ -57,6 +57,9 @@ package body System.Compare_Array_Unsigned_8 is
function To_Big_Bytes is new
  Ada.Unchecked_Conversion (System.Address, Big_Bytes_Ptr);
 
+   pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
+"early returns for performance");
+
--
-- Compare_Arra

[COMMITTED] ada: Adjust again address arithmetics in System.Dwarf_Lines

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

Using the operator of System.Storage_Elements has introduced a range check
that may be tripped on, so this removes the intermediate conversion to the
Storage_Count subtype that is responsible for it.

gcc/ada/

* libgnat/s-dwalin.adb ("-"): New subtraction operator.
(Enable_Cache): Use it to compute the offset.
(Symbolic_Address): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-dwalin.adb | 8 ++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb
index d35d03a8a2f..405b5d32e24 100644
--- a/gcc/ada/libgnat/s-dwalin.adb
+++ b/gcc/ada/libgnat/s-dwalin.adb
@@ -46,6 +46,10 @@ package body System.Dwarf_Lines is
 
subtype Offset is Object_Reader.Offset;
 
+   function "-" (Left, Right : Address) return uint32;
+   pragma Import (Intrinsic, "-");
+   --  Return the difference between two addresses as an unsigned offset
+
function Get_Load_Displacement (C : Dwarf_Context) return Storage_Offset;
--  Return the displacement between the load address present in the binary
--  and the run-time address at which it is loaded (i.e. non-zero for PIE).
@@ -1542,7 +1546,7 @@ package body System.Dwarf_Lines is
exit when Ar_Start = Null_Address and Ar_Len = 0;
 
Len   := uint32 (Ar_Len);
-   Start := uint32 (Storage_Count'(Ar_Start - C.Low));
+   Start := uint32'(Ar_Start - C.Low);
 
--  Search START in the array
 
@@ -1762,7 +1766,7 @@ package body System.Dwarf_Lines is
 
   if C.Cache /= null then
  declare
-Off : constant uint32 := uint32 (Storage_Count'(Addr - C.Low));
+Off : constant uint32 := uint32'(Addr - C.Low);
 
 First, Last, Mid : Natural;
  begin
-- 
2.40.0

[COMMITTED] ada: Fix spurious error on 'Input of private type with Type_Invariant aspect

[Marc Poulhiès via Gcc-patches]

From: Eric Botcazou 

The problem is that it is necessary to break the privacy during the
expansion of the Input attribute, which may introduce a view mismatch
with the parameter of the routine checking the invariant of the type.

gcc/ada/

* exp_util.adb (Make_Invariant_Call): Convert the expression to
the type of the formal parameter if need be.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_util.adb | 23 +++
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 9f843d6d71e..a4b5ec366f3 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9928,11 +9928,16 @@ package body Exp_Util is
-
 
function Make_Invariant_Call (Expr : Node_Id) return Node_Id is
-  Loc : constant Source_Ptr := Sloc (Expr);
-  Typ : constant Entity_Id  := Base_Type (Etype (Expr));
+  Loc  : constant Source_Ptr := Sloc (Expr);
+  Typ  : constant Entity_Id  := Base_Type (Etype (Expr));
   pragma Assert (Has_Invariants (Typ));
-  Proc_Id : constant Entity_Id := Invariant_Procedure (Typ);
+  Proc_Id  : constant Entity_Id := Invariant_Procedure (Typ);
   pragma Assert (Present (Proc_Id));
+  Inv_Typ  : constant Entity_Id
+   := Base_Type (Etype (First_Formal (Proc_Id)));
+
+  Arg : Node_Id;
+
begin
   --  The invariant procedure has a null body if assertions are disabled or
   --  Assertion_Policy Ignore is in effect. In that case, generate a null
@@ -9940,11 +9945,21 @@ package body Exp_Util is
 
   if Has_Null_Body (Proc_Id) then
  return Make_Null_Statement (Loc);
+
   else
+ --  As done elsewhere, for example in Build_Initialization_Call, we
+ --  may need to bridge the gap between views of the type.
+
+ if Inv_Typ /= Typ then
+Arg := OK_Convert_To (Inv_Typ, Expr);
+ else
+Arg := Relocate_Node (Expr);
+ end if;
+
  return
Make_Procedure_Call_Statement (Loc,
  Name   => New_Occurrence_Of (Proc_Id, Loc),
- Parameter_Associations => New_List (Relocate_Node (Expr)));
+ Parameter_Associations => New_List (Arg));
   end if;
end Make_Invariant_Call;
 
-- 
2.40.0

[PATCH v3] mklog: handle Signed-off-by, minor cleanup

[Marc Poulhiès via Gcc-patches]

Consider Signed-off-by lines as part of the ending of the initial
commit to avoid having these in the middle of the log when the
changelog part is injected after.

This is particularly usefull with:

 $ git gcc-commit-mklog --amend -s

that can be used to create the changelog and add the Signed-off-by line.

Also applies most of the shellcheck suggestions on the
prepare-commit-msg hook.

contrib/ChangeLog:

* mklog.py: Leave SOB lines after changelog.
* prepare-commit-msg: Apply most shellcheck suggestions.

Signed-off-by: Marc Poulhiès 
---
Found a small bug in the regex for comments, now fixed.

This command is used in particular during the dev of the frontend
for the Rust language (see r13-7099-g4b25fc15b925f8 as an example
of a SoB ending in the middle of the commit message).

Ok for master?

 contrib/mklog.py   | 34 +-
 contrib/prepare-commit-msg | 20 ++--
 2 files changed, 39 insertions(+), 15 deletions(-)

diff --git a/contrib/mklog.py b/contrib/mklog.py
index 26230b9b4f2..496780883fb 100755
--- a/contrib/mklog.py
+++ b/contrib/mklog.py
@@ -41,7 +41,34 @@ from unidiff import PatchSet
 
 LINE_LIMIT = 100
 TAB_WIDTH = 8
-CO_AUTHORED_BY_PREFIX = 'co-authored-by: '
+
+# Initial commit:
+#   +--+
+#   | gccrs: Some title|
+#   |  | This is the "start"
+#   | This is some text explaining the commit. |
+#   | There can be several lines.  |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+#
+# Results in:
+#   +--+
+#   | gccrs: Some title|
+#   |  |
+#   | This is some text explaining the commit. | This is the "start"
+#   | There can be several lines.  |
+#   |  |<--->
+#   | gcc/rust/ChangeLog:  |
+#   |  | This is the generated
+#   | * some_file (bla):   | ChangeLog part
+#   | (foo):   |
+#   |  |<--->
+#   | Signed-off-by: My Name  | This is the "end"
+#   +--+
+
+# this regex matches the first line of the "end" in the initial commit message
+FIRST_LINE_OF_END_RE = re.compile('(?i)^(signed-off-by:|co-authored-by:|#) ')
 
 pr_regex = re.compile(r'(\/(\/|\*)|[Cc*!])\s+(?PPR [a-z+-]+\/[0-9]+)')
 prnum_regex = re.compile(r'PR (?P[a-z+-]+)/(?P[0-9]+)')
@@ -330,10 +357,7 @@ def update_copyright(data):
 
 
 def skip_line_in_changelog(line):
-if line.lower().startswith(CO_AUTHORED_BY_PREFIX) or line.startswith('#'):
-return False
-return True
-
+return FIRST_LINE_OF_END_RE.match(line) == None
 
 if __name__ == '__main__':
 extra_args = os.getenv('GCC_MKLOG_ARGS')
diff --git a/contrib/prepare-commit-msg b/contrib/prepare-commit-msg
index 48c9dad3c6f..1e94706ba40 100755
--- a/contrib/prepare-commit-msg
+++ b/contrib/prepare-commit-msg
@@ -32,11 +32,11 @@ if ! [ -f "$COMMIT_MSG_FILE" ]; then exit 0; fi
 # Don't do anything unless requested to.
 if [ -z "$GCC_FORCE_MKLOG" ]; then exit 0; fi
 
-if [ -z "$COMMIT_SOURCE" ] || [ $COMMIT_SOURCE = template ]; then
+if [ -z "$COMMIT_SOURCE" ] || [ "$COMMIT_SOURCE" = template ]; then
 # No source or "template" means new commit.
 cmd="diff --cached"
 
-elif [ $COMMIT_SOURCE = message ]; then
+elif [ "$COMMIT_SOURCE" = message ]; then
 # "message" means -m; assume a new commit if there are any changes staged.
 if ! git diff --cached --quiet; then
cmd="diff --cached"
@@ -44,23 +44,23 @@ elif [ $COMMIT_SOURCE = message ]; then
cmd="diff --cached HEAD^"
 fi
 
-elif [ $COMMIT_SOURCE = commit ]; then
+elif [ "$COMMIT_SOURCE" = commit ]; then
 # The message of an existing commit.  If it's HEAD, assume --amend;
 # otherwise, assume a new commit with -C.
-if [ $SHA1 = HEAD ]; then
+if [ "$SHA1" = HEAD ]; then
cmd="diff --cached HEAD^"
if [ "$(git config gcc-config.mklog-hook-type)" = "smart-amend" ]; then
# Check if the existing message still describes the staged changes.
f=$(mktemp /tmp/git-commit.XX) ||

[COMMITTED] ada: Disable inlining of subprograms with Skip(_Flow_And)_Proof in GNATprove

[Marc Poulhiès via Gcc-patches]

From: Yannick Moy 

Subprograms with these Skip(_Flow_And)_Proof annotations should not be
inlined in GNATprove, as we want to skip part of the analysis for their
body.

gcc/ada/

* inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Check for
Skip_Proof and Skip_Flow_And_Proof annotations for deciding
whether a subprogram can be inlined.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/inline.adb | 49 ++
 1 file changed, 49 insertions(+)

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index edb90a9fe20..db8b4164e87 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1503,6 +1503,10 @@ package body Inline is
   --  an unconstrained record type with per-object constraints on component
   --  types.
 
+  function Has_Skip_Proof_Annotation (Id : Entity_Id) return Boolean;
+  --  Returns True if subprogram Id has an annotation Skip_Proof or
+  --  Skip_Flow_And_Proof.
+
   function Has_Some_Contract (Id : Entity_Id) return Boolean;
   --  Return True if subprogram Id has any contract. The presence of
   --  Extensions_Visible or Volatile_Function is also considered as a
@@ -1701,6 +1705,45 @@ package body Inline is
  return False;
   end Has_Formal_With_Discriminant_Dependent_Fields;
 
+  ---
+  -- Has_Skip_Proof_Annotation --
+  ---
+
+  function Has_Skip_Proof_Annotation (Id : Entity_Id) return Boolean is
+ Decl : Node_Id := Unit_Declaration_Node (Id);
+
+  begin
+ Next (Decl);
+
+ while Present (Decl)
+   and then Nkind (Decl) = N_Pragma
+ loop
+if Get_Pragma_Id (Decl) = Pragma_Annotate
+  and then List_Length (Pragma_Argument_Associations (Decl)) = 3
+then
+   declare
+  Arg1  : constant Node_Id :=
+First (Pragma_Argument_Associations (Decl));
+  Arg2  : constant Node_Id := Next (Arg1);
+  Arg1_Name : constant String :=
+Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
+  Arg2_Name : constant String :=
+Get_Name_String (Chars (Get_Pragma_Arg (Arg2)));
+   begin
+  if Arg1_Name = "gnatprove"
+and then Arg2_Name in "skip_proof" | "skip_flow_and_proof"
+  then
+ return True;
+  end if;
+   end;
+end if;
+
+Next (Decl);
+ end loop;
+
+ return False;
+  end Has_Skip_Proof_Annotation;
+
   ---
   -- Has_Some_Contract --
   ---
@@ -1903,6 +1946,12 @@ package body Inline is
   elsif Maybe_Traversal_Function (Id) then
  return False;
 
+  --  Do not inline subprograms with the Skip_Proof or Skip_Flow_And_Proof
+  --  annotation, which should be handled separately.
+
+  elsif Has_Skip_Proof_Annotation (Id) then
+ return False;
+
   --  Otherwise, this is a subprogram declared inside the private part of a
   --  package, or inside a package body, or locally in a subprogram, and it
   --  does not have any contract. Inline it.
-- 
2.40.0

[COMMITTED] ada: Bugbox compiling Constrained_Protected_Object'Image

[Marc Poulhiès via Gcc-patches]

From: Steve Baird 

In some cases, a bugbox is generated when compiling an example
that references X'Image, where X is a constrained object of a
discriminated protected type.

gcc/ada/

* sem_ch3.adb (Constrain_Corresponding_Record): When copying
information from the unconstrained record type to a newly
constructed constrained record subtype, the
Direct_Primitive_Operations attribute must be copied.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ed337f5408e..042ace01724 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -14325,6 +14325,8 @@ package body Sem_Ch3 is
   Set_Is_Constrained(T_Sub, True);
   Set_First_Entity  (T_Sub, First_Entity (Corr_Rec));
   Set_Last_Entity   (T_Sub, Last_Entity  (Corr_Rec));
+  Set_Direct_Primitive_Operations
+(T_Sub, Direct_Primitive_Operations (Corr_Rec));
 
   if Has_Discriminants (Prot_Subt) then -- False only if errors.
  Set_Discriminant_Constraint
-- 
2.40.0

[COMMITTED] ada: Fix printing of numbers in JSON output for data representation

[Marc Poulhiès via Gcc-patches]

From: Yannick Moy 

When calling GNAT with -gnatRj to generate JSON output for the
data representation of types and objects, it could happen that
numbers are printed in the Ada syntax for hexadecimal numbers, which
leads to an invalid JSON file being generated. Now fixed both for
the JSON output and the Ada-like output.

gcc/ada/

* repinfo.adb (Compute_Max_Length): Set parameter to print number
in decimal notation.
(List_Component_Layout): Same.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/repinfo.adb | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index ba4b32b7027..ecd35e94e14 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -1100,7 +1100,7 @@ package body Repinfo is
  goto Continue;
   end if;
 
-  UI_Image (Spos);
+  UI_Image (Spos, Format => Decimal);
else
   --  If the record is not packed, then we know that all fields
   --  whose position is not specified have starting normalized
@@ -1176,7 +1176,7 @@ package body Repinfo is
Spos := Spos + 1;
 end if;
 
-UI_Image (Spos);
+UI_Image (Spos, Format => Decimal);
 Spaces (Max_Spos_Length - UI_Image_Length);
 Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
 
-- 
2.40.0

[COMMITTED] ada: Incorrect optimization for unconstrained limited record component type

[Marc Poulhiès via Gcc-patches]

From: Steve Baird 

If the discriminants of an immutably limited record type have defaults, then
it is safe to assume that a discriminant of an object of this type will never
change once it is initialized. In some cases, this means that the default
discriminant values can be treated like a constraint for purposes of
determining the amount of storage needed for an unconstrained object.
However, it is not safe to perform this optimization when determining
the size needed for an unconstrained component of an enclosing type. This
optimization was sometimes being incorrectly performed in this case. This could
save storage in some cases, but in other cases a constraint check could
incorrectly fail when initializing a component of an aggregate if the
discriminant values of the component differ from the default values.

gcc/ada/

* sem_ch3.adb (Analyze_Component_Declaration): Remove
Build_Default_Subtype_OK call and code that could only executed in
the case where the removed call would have returned True. Other
calls to Build_Default_Subtype_Ok are unaffected by this change.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 18 --
 1 file changed, 18 deletions(-)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 85019dfffa5..ed337f5408e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1868,7 +1868,6 @@ package body Sem_Ch3 is
---
 
procedure Analyze_Component_Declaration (N : Node_Id) is
-  Loc : constant Source_Ptr := Sloc (Component_Definition (N));
   Id  : constant Entity_Id  := Defining_Identifier (N);
   E   : constant Node_Id:= Expression (N);
   Typ : constant Node_Id:=
@@ -2205,23 +2204,6 @@ package body Sem_Ch3 is
  end if;
   end if;
 
-  --  When possible, build the default subtype
-
-  if Build_Default_Subtype_OK (T) then
- declare
-Act_T : constant Entity_Id := Build_Default_Subtype (T, N);
-
- begin
-Set_Etype (Id, Act_T);
-
---  Rewrite component definition to use the constrained subtype
-
-Rewrite (Component_Definition (N),
-  Make_Component_Definition (Loc,
-Subtype_Indication => New_Occurrence_Of (Act_T, Loc)));
- end;
-  end if;
-
   Set_Original_Record_Component (Id, Id);
 
   if Has_Aspects (N) then
-- 
2.40.0

[COMMITTED] ada: Emit SCOs for nested decisions in quantified expressions

[Marc Poulhiès via Gcc-patches]

From: Léo Creuse 

The tree traversal for decision SCO emission did not recurse in the
iterator specification or loop parameter specification of quantified
expressions, resulting in missing coverage obligations for nested
decisions. This change fixes this by traversing all the attributes
of quantified expressions nodes.

gcc/ada/

* par_sco.adb (Process_Decisions): Traverse all attributes of
quantified expressions nodes.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/par_sco.adb | 9 -
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index ce7de7f3d79..5e65fa25de1 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -829,8 +829,15 @@ package body Par_SCO is
 
 when N_Quantified_Expression =>
declare
-  Cond : constant Node_Id := Condition (N);
+  Cond   : constant Node_Id := Condition (N);
+  I_Spec : Node_Id := Empty;
begin
+  if Present (Iterator_Specification (N)) then
+ I_Spec := Iterator_Specification (N);
+  else
+ I_Spec := Loop_Parameter_Specification (N);
+  end if;
+  Process_Decisions (I_Spec, 'X', Pragma_Sloc);
   Process_Decisions (Cond, 'W', Pragma_Sloc);
   return Skip;
end;
-- 
2.40.0

[COMMITTED] ada: Fix generation of JSON output for data representation

[Marc Poulhiès via Gcc-patches]

From: Yannick Moy 

Using -gnatRj to generate data representation in JSON format could
lead to an ill-formed output or an assertion failure. Now fixed.

gcc/ada/

* repinfo.adb (List_Common_Type_Info): Fix output when alignment
is not statically known, and fix assertion when expansion is not
enabled.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/repinfo.adb | 15 ---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index 6a30bc7898b..ba4b32b7027 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -428,12 +428,21 @@ package body Repinfo is
  end if;
 
   --  Alignment is not always set for task, protected, and class-wide
-  --  types. Representation aspects are not computed for types in a
-  --  generic unit.
+  --  types, or when doing semantic analysis only. Representation aspects
+  --  are not computed for types in a generic unit.
 
   else
+ --  Add unknown alignment entry in JSON format to ensure the format is
+ --  valid, as a comma is added by the caller before another field.
+
+ if List_Representation_Info_To_JSON then
+Write_Str ("  ""Alignment"": ");
+Write_Unknown_Val;
+ end if;
+
  pragma Assert
-   (Is_Concurrent_Type (Ent) or else
+   (not Expander_Active or else
+  Is_Concurrent_Type (Ent) or else
   Is_Class_Wide_Type (Ent) or else
   Sem_Util.In_Generic_Scope (Ent));
   end if;
-- 
2.40.0

[COMMITTED] ada: Default Put_Image for composite derived types is missing information

[Marc Poulhiès via Gcc-patches]

From: Pascal Obry 

The output generated by a call to Some_Derived_Composite_Type'Put_Image
(in Ada2022 code) is incomplete in some cases, notably for a type derived
from a container type (i.e., from the Set/Map/List/Vector type declared in
an instance of one of Ada's predefined container generics) with no
user-specified Put_Image procedure.

gcc/ada/

* aspects.ads (Find_Aspect): Add Boolean parameter Or_Rep_Item
(defaulted to False).
* aspects.adb (Find_Aspect): If new Boolean parameter Or_Rep_Item
is True, then instead of returning an empty result if no
appropriate N_Aspect_Specification node is found, return an
appropriate N_Attribute_Definition_Clause if one is found.
* exp_put_image.ads: Change name of Enable_Put_Image function to
Put_Image_Enabled.
* exp_put_image.adb (Build_Record_Put_Image_Procedure): Detect the
case where a call to the Put_Image procedure of a derived type can
be transformed into a call to the parent type's Put_Image
procedure (with a type conversion to the parent type as the actual
parameter).
(Put_Image_Enabled): Change name of function (previously
Enable_Put_Image). Return True in more cases. In particular,
return True for a type with an explicitly specified Put_Image
aspect even if the type is declared in a predefined unit (or in an
instance of a predefined generic unit).
* exp_attr.adb: Changes due to Put_Image_Enabled function name
change.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/aspects.adb   | 30 +---
 gcc/ada/aspects.ads   | 12 --
 gcc/ada/exp_attr.adb  |  4 ++--
 gcc/ada/exp_put_image.adb | 48 +--
 gcc/ada/exp_put_image.ads |  2 +-
 5 files changed, 76 insertions(+), 20 deletions(-)

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index c14769c640c..86dbd183565 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -193,13 +193,14 @@ package body Aspects is
function Find_Aspect
  (Id: Entity_Id;
   A : Aspect_Id;
-  Class_Present : Boolean := False) return Node_Id
+  Class_Present : Boolean := False;
+  Or_Rep_Item   : Boolean := False) return Node_Id
is
-  Decl  : Node_Id;
-  Item  : Node_Id;
-  Owner : Entity_Id;
-  Spec  : Node_Id;
-
+  Decl : Node_Id;
+  Item : Node_Id;
+  Owner: Entity_Id;
+  Spec : Node_Id;
+  Alternative_Rep_Item : Node_Id := Empty;
begin
   Owner := Id;
 
@@ -231,6 +232,18 @@ package body Aspects is
and then Class_Present = Sinfo.Nodes.Class_Present (Item)
  then
 return Item;
+
+ --  We could do something similar here for an N_Pragma node
+ --  when Get_Aspect_Id (Pragma_Name (Item)) = A, but let's
+ --  wait for a demonstrated need.
+
+ elsif Or_Rep_Item
+   and then not Class_Present
+   and then Nkind (Item) = N_Attribute_Definition_Clause
+   and then Get_Aspect_Id (Chars (Item)) = A
+ then
+--  Remember this candidate in case we don't find anything better
+Alternative_Rep_Item := Item;
  end if;
 
  Next_Rep_Item (Item);
@@ -266,9 +279,10 @@ package body Aspects is
   end if;
 
   --  The entity does not carry any aspects or the desired aspect was not
-  --  found.
+  --  found. We have no N_Aspect_Specification node to return, but
+  --  Alternative_Rep_Item may have been set (if Or_Rep_Item is True).
 
-  return Empty;
+  return Alternative_Rep_Item;
end Find_Aspect;
 
--
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 05677978037..f718227a7af 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -1156,10 +1156,18 @@ package Aspects is
 
function Find_Aspect (Id: Entity_Id;
  A : Aspect_Id;
- Class_Present : Boolean := False) return Node_Id;
+ Class_Present : Boolean := False;
+ Or_Rep_Item   : Boolean := False) return Node_Id;
--  Find the aspect specification of aspect A (or A'Class if Class_Present)
--  associated with entity I.
-   --  Return Empty if Id does not have the requested aspect.
+   --  If found, then return the aspect specification.
+   --  If not found and Or_Rep_Item is true, then look for a representation
+   --  item (as opposed to an N_Aspect_Specification node) which specifies
+   --  the given aspect; if found, then return the representation item.
+   --  [Currently only N_Attribute_Definition_Clause representation items
+   --  are checked for, but support for detecting N_Pragma representation
+   --  items could easily be added in the future i

[COMMITTED] ada: check Atree.Get/Set_Field_Value

[Marc Poulhiès via Gcc-patches]

From: Bob Duff 

Get_Field_Value and Set_Field_Value now check that the Nkind or Ekind is
correct. However, the checks are partially disabled, because they
sometimes fail.

gcc/ada/

* atree.adb (Field_Present): New function to detect whether or not
a given field is present in a given node, based on either the node
kind or the entity kind as appropriate.
(Get_Field_Value): Check that the field begin fetched exists.
However, disable the check in the case of Scope_Depth_Value,
because we have failures in that case. Those failures need to be
fixed, and then the check can be enabled for all fields.
(Set_Field_Value): Check that the field begin set exists.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/atree.adb | 20 
 1 file changed, 20 insertions(+)

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index f1e4e2ca8bb..5597d166cdb 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -265,6 +265,10 @@ package body Atree is
   --  True if a node/entity of the given Kind has the given Field.
   --  Always True if assertions are disabled.
 
+  function Field_Present
+(N : Node_Id; Field : Node_Or_Entity_Field) return Boolean;
+  --  Same for a node, which could be an entity
+
end Field_Checking;
 
package body Field_Checking is
@@ -366,6 +370,17 @@ package body Atree is
  return Entity_Fields_Present (Kind) (Field);
   end Field_Present;
 
+  function Field_Present
+(N : Node_Id; Field : Node_Or_Entity_Field) return Boolean is
+  begin
+ case Field is
+when Node_Field =>
+   return Field_Present (Nkind (N), Field);
+when Entity_Field =>
+   return Field_Present (Ekind (N), Field);
+ end case;
+  end Field_Present;
+
end Field_Checking;
 

@@ -885,6 +900,10 @@ package body Atree is
function Get_Field_Value
  (N : Node_Id; Field : Node_Or_Entity_Field) return Field_Size_32_Bit
is
+  pragma Assert
+(if Field /= F_Scope_Depth_Value then -- ???Temporarily disable check
+   Field_Checking.Field_Present (N, Field));
+  --  Assert partially disabled because it fails in rare cases
   Desc : Field_Descriptor renames Field_Descriptors (Field);
   NN : constant Node_Or_Entity_Id := Node_To_Fetch_From (N, Field);
 
@@ -905,6 +924,7 @@ package body Atree is
procedure Set_Field_Value
  (N : Node_Id; Field : Node_Or_Entity_Field; Val : Field_Size_32_Bit)
is
+  pragma Assert (Field_Checking.Field_Present (N, Field));
   Desc : Field_Descriptor renames Field_Descriptors (Field);
 
begin
-- 
2.40.0

[COMMITTED] ada: Add support for binding to a specific network interface controller.

[Marc Poulhiès via Gcc-patches]

From: Pascal Obry 

gcc/ada/

* s-oscons-tmplt.c: Add support for SO_BINDTODEVICE constant.
* libgnat/g-socket.ads (Set_Socket_Option): Handle SO_BINDTODEVICE 
option.
(Get_Socket_Option): Handle SO_BINDTODEVICE option.
* libgnat/g-socket.adb: Likewise.
(Get_Socket_Option): Handle the case where IF_NAMESIZE is not defined
and so equal to -1.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/g-socket.adb | 26 --
 gcc/ada/libgnat/g-socket.ads |  5 +
 gcc/ada/s-oscons-tmplt.c |  5 +
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index dca696f7c5f..c4e29075a0b 100644
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -120,7 +120,8 @@ package body GNAT.Sockets is
 IPv6_Only   => SOSC.IPV6_V6ONLY,
 Send_Timeout=> SOSC.SO_SNDTIMEO,
 Receive_Timeout => SOSC.SO_RCVTIMEO,
-Busy_Polling=> SOSC.SO_BUSY_POLL];
+Busy_Polling=> SOSC.SO_BUSY_POLL,
+Bind_To_Device  => SOSC.SO_BINDTODEVICE];
--  ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
--  but for Linux compatibility this constant is the same as IP_PKTINFO.
 
@@ -1413,17 +1414,21 @@ package body GNAT.Sockets is
   use type C.unsigned;
   use type C.unsigned_char;
 
+  --  SOSC.IF_NAMESIZE may be not defined, ensure that we have at least
+  --  a valid range for VS declared below.
+  NS  : constant Interfaces.C.size_t :=
+  (if SOSC.IF_NAMESIZE = -1 then 256 else SOSC.IF_NAMESIZE);
   V8  : aliased Two_Ints;
   V4  : aliased C.int;
   U4  : aliased C.unsigned;
   V1  : aliased C.unsigned_char;
+  VS  : aliased C.char_array (1 .. NS); -- for devices name
   VT  : aliased Timeval;
   Len : aliased C.int;
   Add : System.Address;
   Res : C.int;
   Opt : Option_Type (Name);
   Onm : Interfaces.C.int;
-
begin
   if Name in Specific_Option_Name then
  Onm := Options (Name);
@@ -1491,6 +1496,11 @@ package body GNAT.Sockets is
  =>
 Len := V8'Size / 8;
 Add := V8'Address;
+
+ when Bind_To_Device
+ =>
+Len := VS'Length;
+Add := VS'Address;
   end case;
 
   Res :=
@@ -1589,6 +1599,9 @@ package body GNAT.Sockets is
 else
Opt.Timeout := To_Duration (VT);
 end if;
+
+ when Bind_To_Device =>
+Opt.Device := ASU.To_Unbounded_String (C.To_Ada (VS));
   end case;
 
   return Opt;
@@ -2616,6 +2629,10 @@ package body GNAT.Sockets is
   V4  : aliased C.int;
   U4  : aliased C.unsigned;
   V1  : aliased C.unsigned_char;
+  VS  : aliased C.char_array
+  (1 .. (if Option.Name = Bind_To_Device
+ then C.size_t (ASU.Length (Option.Device) + 1)
+ else 0));
   VT  : aliased Timeval;
   Len : C.int;
   Add : System.Address := Null_Address;
@@ -2754,6 +2771,11 @@ package body GNAT.Sockets is
Len := VT'Size / 8;
Add := VT'Address;
 end if;
+
+ when Bind_To_Device =>
+VS := C.To_C (ASU.To_String (Option.Device));
+Len := C.int (VS'Length);
+Add := VS'Address;
   end case;
 
   if Option.Name in Specific_Option_Name then
diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads
index d49245290ce..90740ec65a4 100644
--- a/gcc/ada/libgnat/g-socket.ads
+++ b/gcc/ada/libgnat/g-socket.ads
@@ -841,6 +841,9 @@ package GNAT.Sockets is
   --  Sets the approximate time in microseconds to busy poll on a blocking
   --  receive when there is no data.
 
+  Bind_To_Device,  -- SO_BINDTODEVICE
+  --  Bind to a specific NIC (Network Interface Controller)
+
   ---
   -- IP_Protocol_For_TCP_Level --
   ---
@@ -986,6 +989,8 @@ package GNAT.Sockets is
   Receive_Timeout =>
 Timeout : Timeval_Duration;
 
+ when Bind_To_Device =>
+Device : Ada.Strings.Unbounded.Unbounded_String;
   end case;
end record;
 
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 28d42c5a459..fb6bb0f043b 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -1545,6 +1545,11 @@ CND(SO_KEEPALIVE, "Enable keep-alive msgs")
 #endif
 CND(SO_LINGER, "Defer close to flush data")
 
+#ifndef SO_BINDTODEVICE
+# define SO_BINDTODEVICE -1
+#endif
+CND(SO_BINDTODEVICE, "Bind to a NIC - Network Interface Controller")
+
 #ifndef SO_BROADCAST
 # define SO_BROADCAST -1
 #endif
-- 
2.40.0