public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [COMMITTED 01/17] ada: Update documentation for conditional when constructs
@ 2024-08-29 13:07 Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 02/17] ada: First controlling parameter aspect Marc Poulhiès
                   ` (15 more replies)
  0 siblings, 16 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Justin Squirek

From: Justin Squirek <squirek@adacore.com>

This patch moves the documentation for conditional when constructs out of the
curated set (e.g. into -gnatX0).

gcc/ada/

	* doc/gnat_rm/gnat_language_extensions.rst: Move conditional when
	constructs out of the curated set.
	* gnat_rm.texi: Regenerate.
	* gnat_ugn.texi: Regenerate.

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

---
 .../doc/gnat_rm/gnat_language_extensions.rst  | 141 ++++++++-------
 gcc/ada/gnat_rm.texi                          | 170 +++++++++---------
 gcc/ada/gnat_ugn.texi                         |   4 +-
 3 files changed, 157 insertions(+), 158 deletions(-)

diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
index 32f00c0c7a5..af10289b8b1 100644
--- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
+++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
@@ -68,77 +68,6 @@ For example:
 Link to the original RFC:
 https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-local-vars-without-block.md
 
-Conditional when constructs
----------------------------
-
-This feature extends the use of ``when`` as a way to condition a control-flow
-related statement, to all control-flow related statements.
-
-To do a conditional return in a procedure the following syntax should be used:
-
-.. code-block:: ada
-
-   procedure P (Condition : Boolean) is
-   begin
-      return when Condition;
-   end;
-
-This will return from the procedure if ``Condition`` is true.
-
-When being used in a function the conditional part comes after the return value:
-
-.. code-block:: ada
-
-   function Is_Null (I : Integer) return Boolean is
-   begin
-      return True when I = 0;
-      return False;
-   end;
-
-In a similar way to the ``exit when`` a ``goto ... when`` can be employed:
-
-.. code-block:: ada
-
-   procedure Low_Level_Optimized is
-      Flags : Bitmapping;
-   begin
-      Do_1 (Flags);
-      goto Cleanup when Flags (1);
-
-      Do_2 (Flags);
-      goto Cleanup when Flags (32);
-
-      --  ...
-
-   <<Cleanup>>
-      --  ...
-   end;
-
-.. code-block
-
-To use a conditional raise construct:
-
-.. code-block:: ada
-
-   procedure Foo is
-   begin
-      raise Error when Imported_C_Func /= 0;
-   end;
-
-An exception message can also be added:
-
-.. code-block:: ada
-
-   procedure Foo is
-   begin
-      raise Error with "Unix Error"
-        when Imported_C_Func /= 0;
-   end;
-
-
-Link to the original RFC:
-https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-conditional-when-constructs.rst
-
 Fixed lower bounds for array types and subtypes
 -----------------------------------------------
 
@@ -345,6 +274,76 @@ particular the ``Shift_Left`` and ``Shift_Right`` intrinsics.
 Experimental Language Extensions
 ================================
 
+Conditional when constructs
+---------------------------
+
+This feature extends the use of ``when`` as a way to condition a control-flow
+related statement, to all control-flow related statements.
+
+To do a conditional return in a procedure the following syntax should be used:
+
+.. code-block:: ada
+
+   procedure P (Condition : Boolean) is
+   begin
+      return when Condition;
+   end;
+
+This will return from the procedure if ``Condition`` is true.
+
+When being used in a function the conditional part comes after the return value:
+
+.. code-block:: ada
+
+   function Is_Null (I : Integer) return Boolean is
+   begin
+      return True when I = 0;
+      return False;
+   end;
+
+In a similar way to the ``exit when`` a ``goto ... when`` can be employed:
+
+.. code-block:: ada
+
+   procedure Low_Level_Optimized is
+      Flags : Bitmapping;
+   begin
+      Do_1 (Flags);
+      goto Cleanup when Flags (1);
+
+      Do_2 (Flags);
+      goto Cleanup when Flags (32);
+
+      --  ...
+
+   <<Cleanup>>
+      --  ...
+   end;
+
+.. code-block
+
+To use a conditional raise construct:
+
+.. code-block:: ada
+
+   procedure Foo is
+   begin
+      raise Error when Imported_C_Func /= 0;
+   end;
+
+An exception message can also be added:
+
+.. code-block:: ada
+
+   procedure Foo is
+   begin
+      raise Error with "Unix Error"
+        when Imported_C_Func /= 0;
+   end;
+
+Link to the original RFC:
+https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-conditional-when-constructs.rst
+
 Storage Model
 -------------
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 3a766ccc38d..a2c14e203c3 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Jul 29, 2024
+GNAT Reference Manual , Aug 26, 2024
 
 AdaCore
 
@@ -895,7 +895,6 @@ GNAT language extensions
 Curated Extensions
 
 * Local Declarations Without Block:: 
-* Conditional when constructs:: 
 * Fixed lower bounds for array types and subtypes:: 
 * Prefixed-view notation for calls to primitive subprograms of untagged types:: 
 * Expression defaults for generic formal functions:: 
@@ -905,6 +904,7 @@ Curated Extensions
 
 Experimental Language Extensions
 
+* Conditional when constructs:: 
 * Storage Model:: 
 * Attribute Super:: 
 * Simpler accessibility model:: 
@@ -28939,7 +28939,6 @@ for use in playground experiments.
 
 @menu
 * Local Declarations Without Block:: 
-* Conditional when constructs:: 
 * Fixed lower bounds for array types and subtypes:: 
 * Prefixed-view notation for calls to primitive subprograms of untagged types:: 
 * Expression defaults for generic formal functions:: 
@@ -28949,7 +28948,7 @@ for use in playground experiments.
 
 @end menu
 
-@node Local Declarations Without Block,Conditional when constructs,,Curated Extensions
+@node Local Declarations Without Block,Fixed lower bounds for array types and subtypes,,Curated Extensions
 @anchor{gnat_rm/gnat_language_extensions local-declarations-without-block}@anchor{445}
 @subsection Local Declarations Without Block
 
@@ -28973,80 +28972,8 @@ end if;
 Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-local-vars-without-block.md}
 
-@node Conditional when constructs,Fixed lower bounds for array types and subtypes,Local Declarations Without Block,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{446}
-@subsection Conditional when constructs
-
-
-This feature extends the use of @code{when} as a way to condition a control-flow
-related statement, to all control-flow related statements.
-
-To do a conditional return in a procedure the following syntax should be used:
-
-@example
-procedure P (Condition : Boolean) is
-begin
-   return when Condition;
-end;
-@end example
-
-This will return from the procedure if @code{Condition} is true.
-
-When being used in a function the conditional part comes after the return value:
-
-@example
-function Is_Null (I : Integer) return Boolean is
-begin
-   return True when I = 0;
-   return False;
-end;
-@end example
-
-In a similar way to the @code{exit when} a @code{goto ... when} can be employed:
-
-@example
-procedure Low_Level_Optimized is
-   Flags : Bitmapping;
-begin
-   Do_1 (Flags);
-   goto Cleanup when Flags (1);
-
-   Do_2 (Flags);
-   goto Cleanup when Flags (32);
-
-   --  ...
-
-<<Cleanup>>
-   --  ...
-end;
-@end example
-
-@c code-block
-
-To use a conditional raise construct:
-
-@example
-procedure Foo is
-begin
-   raise Error when Imported_C_Func /= 0;
-end;
-@end example
-
-An exception message can also be added:
-
-@example
-procedure Foo is
-begin
-   raise Error with "Unix Error"
-     when Imported_C_Func /= 0;
-end;
-@end example
-
-Link to the original RFC:
-@indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-conditional-when-constructs.rst}
-
-@node Fixed lower bounds for array types and subtypes,Prefixed-view notation for calls to primitive subprograms of untagged types,Conditional when constructs,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions fixed-lower-bounds-for-array-types-and-subtypes}@anchor{447}
+@node Fixed lower bounds for array types and subtypes,Prefixed-view notation for calls to primitive subprograms of untagged types,Local Declarations Without Block,Curated Extensions
+@anchor{gnat_rm/gnat_language_extensions fixed-lower-bounds-for-array-types-and-subtypes}@anchor{446}
 @subsection Fixed lower bounds for array types and subtypes
 
 
@@ -29100,7 +29027,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-fixed-lower-bound.rst}
 
 @node Prefixed-view notation for calls to primitive subprograms of untagged types,Expression defaults for generic formal functions,Fixed lower bounds for array types and subtypes,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions prefixed-view-notation-for-calls-to-primitive-subprograms-of-untagged-types}@anchor{448}
+@anchor{gnat_rm/gnat_language_extensions prefixed-view-notation-for-calls-to-primitive-subprograms-of-untagged-types}@anchor{447}
 @subsection Prefixed-view notation for calls to primitive subprograms of untagged types
 
 
@@ -29153,7 +29080,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-prefixed-untagged.rst}
 
 @node Expression defaults for generic formal functions,String interpolation,Prefixed-view notation for calls to primitive subprograms of untagged types,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions expression-defaults-for-generic-formal-functions}@anchor{449}
+@anchor{gnat_rm/gnat_language_extensions expression-defaults-for-generic-formal-functions}@anchor{448}
 @subsection Expression defaults for generic formal functions
 
 
@@ -29182,7 +29109,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-expression-functions-as-default-for-generic-formal-function-parameters.rst}
 
 @node String interpolation,Constrained attribute for generic objects,Expression defaults for generic formal functions,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions string-interpolation}@anchor{44a}
+@anchor{gnat_rm/gnat_language_extensions string-interpolation}@anchor{449}
 @subsection String interpolation
 
 
@@ -29336,7 +29263,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-string-interpolation.md}
 
 @node Constrained attribute for generic objects,Static aspect on intrinsic functions,String interpolation,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions constrained-attribute-for-generic-objects}@anchor{44b}
+@anchor{gnat_rm/gnat_language_extensions constrained-attribute-for-generic-objects}@anchor{44a}
 @subsection Constrained attribute for generic objects
 
 
@@ -29344,7 +29271,7 @@ The @code{Constrained} attribute is permitted for objects of generic types. The
 result indicates whether the corresponding actual is constrained.
 
 @node Static aspect on intrinsic functions,,Constrained attribute for generic objects,Curated Extensions
-@anchor{gnat_rm/gnat_language_extensions static-aspect-on-intrinsic-functions}@anchor{44c}
+@anchor{gnat_rm/gnat_language_extensions static-aspect-on-intrinsic-functions}@anchor{44b}
 @subsection @code{Static} aspect on intrinsic functions
 
 
@@ -29353,11 +29280,12 @@ and the compiler will evaluate some of these intrinsics statically, in
 particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
 
 @node Experimental Language Extensions,,Curated Extensions,GNAT language extensions
-@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6a}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{44d}
+@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6a}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{44c}
 @section Experimental Language Extensions
 
 
 @menu
+* Conditional when constructs:: 
 * Storage Model:: 
 * Attribute Super:: 
 * Simpler accessibility model:: 
@@ -29367,7 +29295,79 @@ particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
 
 @end menu
 
-@node Storage Model,Attribute Super,,Experimental Language Extensions
+@node Conditional when constructs,Storage Model,,Experimental Language Extensions
+@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{44d}
+@subsection Conditional when constructs
+
+
+This feature extends the use of @code{when} as a way to condition a control-flow
+related statement, to all control-flow related statements.
+
+To do a conditional return in a procedure the following syntax should be used:
+
+@example
+procedure P (Condition : Boolean) is
+begin
+   return when Condition;
+end;
+@end example
+
+This will return from the procedure if @code{Condition} is true.
+
+When being used in a function the conditional part comes after the return value:
+
+@example
+function Is_Null (I : Integer) return Boolean is
+begin
+   return True when I = 0;
+   return False;
+end;
+@end example
+
+In a similar way to the @code{exit when} a @code{goto ... when} can be employed:
+
+@example
+procedure Low_Level_Optimized is
+   Flags : Bitmapping;
+begin
+   Do_1 (Flags);
+   goto Cleanup when Flags (1);
+
+   Do_2 (Flags);
+   goto Cleanup when Flags (32);
+
+   --  ...
+
+<<Cleanup>>
+   --  ...
+end;
+@end example
+
+@c code-block
+
+To use a conditional raise construct:
+
+@example
+procedure Foo is
+begin
+   raise Error when Imported_C_Func /= 0;
+end;
+@end example
+
+An exception message can also be added:
+
+@example
+procedure Foo is
+begin
+   raise Error with "Unix Error"
+     when Imported_C_Func /= 0;
+end;
+@end example
+
+Link to the original RFC:
+@indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-conditional-when-constructs.rst}
+
+@node Storage Model,Attribute Super,Conditional when constructs,Experimental Language Extensions
 @anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{44e}
 @subsection Storage Model
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index dcde9ea705b..27c705e3bbd 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 19, 2024
+GNAT User's Guide for Native Platforms , Aug 26, 2024
 
 AdaCore
 
@@ -29695,8 +29695,8 @@ to permit their use in free software.
 
 @printindex ge
 
-@anchor{d1}@w{                              }
 @anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{                              }
+@anchor{d1}@w{                              }
 
 @c %**end of body
 @bye
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 02/17] ada: First controlling parameter aspect
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 03/17] ada: Proper handling for iterator associations in array aggregates Marc Poulhiès
                   ` (14 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Javier Miranda

From: Javier Miranda <miranda@adacore.com>

gcc/ada/

	* usage.adb (Usage): Document switch -gnatw_j
	* doc/gnat_rm/gnat_language_extensions.rst: Add documentation.
	* gnat_rm.texi: Regenerate.

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

---
 .../doc/gnat_rm/gnat_language_extensions.rst  |  82 +++++++++
 gcc/ada/gnat_rm.texi                          | 166 +++++++++++++-----
 gcc/ada/usage.adb                             |   3 +
 3 files changed, 211 insertions(+), 40 deletions(-)

diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
index af10289b8b1..27be5e0c3d5 100644
--- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
+++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
@@ -269,6 +269,88 @@ The Ada 202x ``Static`` aspect can be specified on Intrinsic imported functions
 and the compiler will evaluate some of these intrinsics statically, in
 particular the ``Shift_Left`` and ``Shift_Right`` intrinsics.
 
+First Controlling Parameter
+---------------------------
+
+A new pragma/aspect, ``First_Controlling_Parameter``, is introduced for tagged
+types, altering the semantics of primitive/controlling parameters. When a
+tagged type is marked with this aspect, only subprograms where the first
+parameter is of that type will be considered dispatching primitives. This
+pragma/aspect applies to the entire hierarchy, starting from the specified
+type, without affecting inherited primitives.
+
+Here is an example of this feature:
+
+.. code-block:: ada
+
+    package Example is
+       type Root is tagged private;
+
+       procedure P (V : Integer; V2 : Root);
+       -- Primitive
+
+       type Child is tagged private
+         with First_Controlling_Parameter;
+
+    private
+       type Root is tagged null record;
+       type Child is new Root with null record;
+
+       overriding
+       procedure P (V : Integer; V2 : Child);
+       -- Primitive
+
+       procedure P2 (V : Integer; V2 : Child);
+       -- NOT Primitive
+
+       function F return Child; -- NOT Primitive
+
+       function F2 (V : Child) return Child;
+       -- Primitive, but only controlling on the first parameter
+    end;
+
+Note that ``function F2 (V : Child) return Child;`` differs from ``F2 (V : Child)
+return Child'Class;`` in that the return type is a specific, definite type. This
+is also distinct from the legacy semantics, where further derivations with
+added fields would require overriding the function.
+
+The option ``-gnatw_j``, that you can pass to the compiler directly, enables
+warnings related to this new language feature. For instance, compiling the
+example above without this switch produces no warnings, but compiling it with
+``-gnatw_j`` generates the following warning on the declaration of procedure P2:
+
+.. code-block:: ada
+
+    warning: not a dispatching primitive of tagged type "Child"
+    warning: disallowed by First_Controlling_Parameter on "Child"
+
+For generic formal tagged types, you can specify whether the type has the
+First_Controlling_Parameter aspect enabled:
+
+.. code-block:: ada
+
+    generic
+       type T is tagged private with First_Controlling_Parameter;
+    package T is
+        type U is new T with null record;
+        function Foo return U; -- Not a primitive
+    end T;
+
+For tagged partial views, the value of the aspect must be consistent between
+the partial and full views:
+
+.. code-block:: ada
+
+    package R is
+       type T is tagged private;
+    ...
+    private
+       type T is tagged null record with First_Controlling_Parameter; -- ILLEGAL
+    end R;
+
+Link to the original RFC:
+https://github.com/AdaCore/ada-spark-rfcs/blob/master/considered/rfc-oop-first-controlling.rst
+
 .. _Experimental_Language_Extensions:
 
 Experimental Language Extensions
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index a2c14e203c3..f901b0e133e 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -901,6 +901,7 @@ Curated Extensions
 * String interpolation:: 
 * Constrained attribute for generic objects:: 
 * Static aspect on intrinsic functions:: 
+* First Controlling Parameter:: 
 
 Experimental Language Extensions
 
@@ -28945,6 +28946,7 @@ for use in playground experiments.
 * String interpolation:: 
 * Constrained attribute for generic objects:: 
 * Static aspect on intrinsic functions:: 
+* First Controlling Parameter:: 
 
 @end menu
 
@@ -29270,7 +29272,7 @@ Link to the original RFC:
 The @code{Constrained} attribute is permitted for objects of generic types. The
 result indicates whether the corresponding actual is constrained.
 
-@node Static aspect on intrinsic functions,,Constrained attribute for generic objects,Curated Extensions
+@node Static aspect on intrinsic functions,First Controlling Parameter,Constrained attribute for generic objects,Curated Extensions
 @anchor{gnat_rm/gnat_language_extensions static-aspect-on-intrinsic-functions}@anchor{44b}
 @subsection @code{Static} aspect on intrinsic functions
 
@@ -29279,8 +29281,92 @@ The Ada 202x @code{Static} aspect can be specified on Intrinsic imported functio
 and the compiler will evaluate some of these intrinsics statically, in
 particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
 
+@node First Controlling Parameter,,Static aspect on intrinsic functions,Curated Extensions
+@anchor{gnat_rm/gnat_language_extensions first-controlling-parameter}@anchor{44c}
+@subsection First Controlling Parameter
+
+
+A new pragma/aspect, @code{First_Controlling_Parameter}, is introduced for tagged
+types, altering the semantics of primitive/controlling parameters. When a
+tagged type is marked with this aspect, only subprograms where the first
+parameter is of that type will be considered dispatching primitives. This
+pragma/aspect applies to the entire hierarchy, starting from the specified
+type, without affecting inherited primitives.
+
+Here is an example of this feature:
+
+@example
+package Example is
+   type Root is tagged private;
+
+   procedure P (V : Integer; V2 : Root);
+   -- Primitive
+
+   type Child is tagged private
+     with First_Controlling_Parameter;
+
+private
+   type Root is tagged null record;
+   type Child is new Root with null record;
+
+   overriding
+   procedure P (V : Integer; V2 : Child);
+   -- Primitive
+
+   procedure P2 (V : Integer; V2 : Child);
+   -- NOT Primitive
+
+   function F return Child; -- NOT Primitive
+
+   function F2 (V : Child) return Child;
+   -- Primitive, but only controlling on the first parameter
+end;
+@end example
+
+Note that @code{function F2 (V : Child) return Child;} differs from @code{F2 (V : Child)
+return Child'Class;} in that the return type is a specific, definite type. This
+is also distinct from the legacy semantics, where further derivations with
+added fields would require overriding the function.
+
+The option @code{-gnatw_j}, that you can pass to the compiler directly, enables
+warnings related to this new language feature. For instance, compiling the
+example above without this switch produces no warnings, but compiling it with
+@code{-gnatw_j} generates the following warning on the declaration of procedure P2:
+
+@example
+warning: not a dispatching primitive of tagged type "Child"
+warning: disallowed by First_Controlling_Parameter on "Child"
+@end example
+
+For generic formal tagged types, you can specify whether the type has the
+First_Controlling_Parameter aspect enabled:
+
+@example
+generic
+   type T is tagged private with First_Controlling_Parameter;
+package T is
+    type U is new T with null record;
+    function Foo return U; -- Not a primitive
+end T;
+@end example
+
+For tagged partial views, the value of the aspect must be consistent between
+the partial and full views:
+
+@example
+package R is
+   type T is tagged private;
+...
+private
+   type T is tagged null record with First_Controlling_Parameter; -- ILLEGAL
+end R;
+@end example
+
+Link to the original RFC:
+@indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/considered/rfc-oop-first-controlling.rst}
+
 @node Experimental Language Extensions,,Curated Extensions,GNAT language extensions
-@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6a}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{44c}
+@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6a}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{44d}
 @section Experimental Language Extensions
 
 
@@ -29296,7 +29382,7 @@ particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
 @end menu
 
 @node Conditional when constructs,Storage Model,,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{44d}
+@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{44e}
 @subsection Conditional when constructs
 
 
@@ -29368,7 +29454,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-conditional-when-constructs.rst}
 
 @node Storage Model,Attribute Super,Conditional when constructs,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{44e}
+@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{44f}
 @subsection Storage Model
 
 
@@ -29383,7 +29469,7 @@ Here is a link to the full RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-storage-model.rst}
 
 @node Attribute Super,Simpler accessibility model,Storage Model,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{44f}
+@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{450}
 @subsection Attribute Super
 
 
@@ -29413,7 +29499,7 @@ Here is a link to the full RFC:
 @indicateurl{https://github.com/QuentinOchem/ada-spark-rfcs/blob/oop/considered/rfc-oop-super.rst}
 
 @node Simpler accessibility model,Case pattern matching,Attribute Super,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{450}
+@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{451}
 @subsection Simpler accessibility model
 
 
@@ -29426,7 +29512,7 @@ Here is a link to the full RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-simpler-accessibility.md}
 
 @node Case pattern matching,Mutably Tagged Types with Size’Class Aspect,Simpler accessibility model,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{451}
+@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{452}
 @subsection Case pattern matching
 
 
@@ -29558,7 +29644,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-pattern-matching.rst}
 
 @node Mutably Tagged Types with Size’Class Aspect,Generalized Finalization,Case pattern matching,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{452}
+@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{453}
 @subsection Mutably Tagged Types with Size’Class Aspect
 
 
@@ -29598,7 +29684,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/topic/rfc-finally/considered/rfc-class-size.md}
 
 @node Generalized Finalization,,Mutably Tagged Types with Size’Class Aspect,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{453}
+@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{454}
 @subsection Generalized Finalization
 
 
@@ -29630,7 +29716,7 @@ Link to the original RFC:
 @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/topic/finalization-rehaul/considered/rfc-generalized-finalization.md}
 
 @node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top
-@anchor{gnat_rm/security_hardening_features doc}@anchor{454}@anchor{gnat_rm/security_hardening_features id1}@anchor{455}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
+@anchor{gnat_rm/security_hardening_features doc}@anchor{455}@anchor{gnat_rm/security_hardening_features id1}@anchor{456}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
 @chapter Security Hardening Features
 
 
@@ -29652,7 +29738,7 @@ change.
 @end menu
 
 @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{456}
+@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{457}
 @section Register Scrubbing
 
 
@@ -29688,7 +29774,7 @@ programming languages, see @cite{Using the GNU Compiler Collection (GCC)}.
 @c Stack Scrubbing:
 
 @node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{457}
+@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{458}
 @section Stack Scrubbing
 
 
@@ -29832,7 +29918,7 @@ Bar_Callable_Ptr.
 @c Hardened Conditionals:
 
 @node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{458}
+@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{459}
 @section Hardened Conditionals
 
 
@@ -29922,7 +30008,7 @@ be used with other programming languages supported by GCC.
 @c Hardened Booleans:
 
 @node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{459}
+@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{45a}
 @section Hardened Booleans
 
 
@@ -29983,7 +30069,7 @@ and more details on that attribute, see @cite{Using the GNU Compiler Collection
 @c Control Flow Redundancy:
 
 @node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{45a}
+@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{45b}
 @section Control Flow Redundancy
 
 
@@ -30151,7 +30237,7 @@ see @cite{Using the GNU Compiler Collection (GCC)}.  These options
 can be used with other programming languages supported by GCC.
 
 @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top
-@anchor{gnat_rm/obsolescent_features doc}@anchor{45b}@anchor{gnat_rm/obsolescent_features id1}@anchor{45c}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
+@anchor{gnat_rm/obsolescent_features doc}@anchor{45c}@anchor{gnat_rm/obsolescent_features id1}@anchor{45d}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
 @chapter Obsolescent Features
 
 
@@ -30170,7 +30256,7 @@ compatibility purposes.
 @end menu
 
 @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id2}@anchor{45d}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{45e}
+@anchor{gnat_rm/obsolescent_features id2}@anchor{45e}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{45f}
 @section pragma No_Run_Time
 
 
@@ -30183,7 +30269,7 @@ preferred usage is to use an appropriately configured run-time that
 includes just those features that are to be made accessible.
 
 @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id3}@anchor{45f}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{460}
+@anchor{gnat_rm/obsolescent_features id3}@anchor{460}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{461}
 @section pragma Ravenscar
 
 
@@ -30192,7 +30278,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma
 is part of the new Ada 2005 standard.
 
 @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id4}@anchor{461}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{462}
+@anchor{gnat_rm/obsolescent_features id4}@anchor{462}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{463}
 @section pragma Restricted_Run_Time
 
 
@@ -30202,7 +30288,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for
 this kind of implementation dependent addition.
 
 @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id5}@anchor{463}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{464}
+@anchor{gnat_rm/obsolescent_features id5}@anchor{464}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{465}
 @section pragma Task_Info
 
 
@@ -30228,7 +30314,7 @@ in the spec of package System.Task_Info in the runtime
 library.
 
 @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{465}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{466}
+@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{466}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{467}
 @section package System.Task_Info (@code{s-tasinf.ads})
 
 
@@ -30238,7 +30324,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package
 standard replacement for GNAT’s @code{Task_Info} functionality.
 
 @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top
-@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{467}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{468}
+@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{468}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{469}
 @chapter Compatibility and Porting Guide
 
 
@@ -30260,7 +30346,7 @@ applications developed in other Ada environments.
 @end menu
 
 @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{46a}
+@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{46a}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{46b}
 @section Writing Portable Fixed-Point Declarations
 
 
@@ -30382,7 +30468,7 @@ If you follow this scheme you will be guaranteed that your fixed-point
 types will be portable.
 
 @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{46b}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{46c}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{46d}
 @section Compatibility with Ada 83
 
 
@@ -30410,7 +30496,7 @@ following subsections treat the most likely issues to be encountered.
 @end menu
 
 @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{46d}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{46e}
+@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{46e}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{46f}
 @subsection Legal Ada 83 programs that are illegal in Ada 95
 
 
@@ -30510,7 +30596,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration.
 @end itemize
 
 @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{46f}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{470}
+@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{470}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{471}
 @subsection More deterministic semantics
 
 
@@ -30538,7 +30624,7 @@ which open select branches are executed.
 @end itemize
 
 @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{471}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{472}
+@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{472}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{473}
 @subsection Changed semantics
 
 
@@ -30580,7 +30666,7 @@ covers only the restricted range.
 @end itemize
 
 @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{473}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{474}
+@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{474}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{475}
 @subsection Other language compatibility issues
 
 
@@ -30613,7 +30699,7 @@ include @code{pragma Interface} and the floating point type attributes
 @end itemize
 
 @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{475}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{476}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{476}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{477}
 @section Compatibility between Ada 95 and Ada 2005
 
 
@@ -30685,7 +30771,7 @@ can declare a function returning a value from an anonymous access type.
 @end itemize
 
 @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{477}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{478}
+@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{478}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{479}
 @section Implementation-dependent characteristics
 
 
@@ -30708,7 +30794,7 @@ transition from certain Ada 83 compilers.
 @end menu
 
 @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{479}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{47a}
+@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{47a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{47b}
 @subsection Implementation-defined pragmas
 
 
@@ -30730,7 +30816,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not
 relevant in a GNAT context and hence are not otherwise implemented.
 
 @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{47b}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{47c}
+@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{47c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{47d}
 @subsection Implementation-defined attributes
 
 
@@ -30744,7 +30830,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and
 @code{Type_Class}.
 
 @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{47d}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{47e}
+@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{47e}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{47f}
 @subsection Libraries
 
 
@@ -30773,7 +30859,7 @@ be preferable to retrofit the application using modular types.
 @end itemize
 
 @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{47f}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{480}
+@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{480}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{481}
 @subsection Elaboration order
 
 
@@ -30809,7 +30895,7 @@ pragmas either globally (as an effect of the `-gnatE' switch) or locally
 @end itemize
 
 @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{481}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{482}
+@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{482}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{483}
 @subsection Target-specific aspects
 
 
@@ -30822,10 +30908,10 @@ on the robustness of the original design.  Moreover, Ada 95 (and thus
 Ada 2005 and Ada 2012) are sometimes
 incompatible with typical Ada 83 compiler practices regarding implicit
 packing, the meaning of the Size attribute, and the size of access values.
-GNAT’s approach to these issues is described in @ref{483,,Representation Clauses}.
+GNAT’s approach to these issues is described in @ref{484,,Representation Clauses}.
 
 @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{484}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{485}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{485}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{486}
 @section Compatibility with Other Ada Systems
 
 
@@ -30868,7 +30954,7 @@ far beyond this minimal set, as described in the next section.
 @end itemize
 
 @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{486}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{483}
+@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{484}
 @section Representation Clauses
 
 
@@ -30961,7 +31047,7 @@ with thin pointers.
 @end itemize
 
 @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{488}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{488}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{489}
 @section Compatibility with HP Ada 83
 
 
@@ -30991,7 +31077,7 @@ extension of package System.
 @end itemize
 
 @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top
-@anchor{share/gnu_free_documentation_license doc}@anchor{489}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{48a}
+@anchor{share/gnu_free_documentation_license doc}@anchor{48a}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{48b}
 @chapter GNU Free Documentation License
 
 
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 59cbd6f4a2f..5b7743703c5 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -527,6 +527,9 @@ begin
                                                   "primitives");
    Write_Line ("        .J*  turn off warnings for late dispatching " &
                                                   "primitives");
+   Write_Line ("        _j   turn on warnings for First_Controlling_" &
+                                                  "Parameter aspect");
+
    Write_Line ("        k+   turn on warnings on constant variable");
    Write_Line ("        K*   turn off warnings on constant variable");
    Write_Line ("        .k   turn on warnings for standard redefinition");
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 03/17] ada: Proper handling for iterator associations in array aggregates
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 02/17] ada: First controlling parameter aspect Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 04/17] ada: Display actual line length in line length check Marc Poulhiès
                   ` (13 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Gary Dismukes

From: Gary Dismukes <dismukes@adacore.com>

The compiler was flagging type-mismatch errors on iterated component
associations in array aggregates of form "for C in <iterator_name>",
improperly requiring the type of the iterator to be the array index
type. The parser can't distinguish whether the association is one
involving an actual discrete choice vs. an iterator specification,
and creates an N_Iterated_Component_Association with a Defining_Identifer
and Discrete_Choices, and the analysis phase has to disambiguate this,
determining whether to create an N_Iterator_Specification node for
the association. A related change is to revise the similar code for
iterated associations of container aggregates, to allow forms of
iterator objects other than just function calls.

gcc/ada/

	* sem_aggr.adb (Resolve_Array_Aggregate): Add loop over associations to locate
	N_Iterated_Component_Associations that do not have an Iterator_Specification,
	and if their Discrete_Choices list consists of a single choice, analyze it and
	if it's the name of an iterator object, then create an Iterator_Specification
	and associate it with the iterated component association.
	(Resolve_Iterated_Association): Replace test for function call with test of
	Is_Object_Reference, to handle other forms of iterator objects in container
	aggregates.

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

---
 gcc/ada/sem_aggr.adb | 62 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 61 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 087e324b5c1..8319ff5af62 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2542,6 +2542,66 @@ package body Sem_Aggr is
          null;
 
       elsif Present (Component_Associations (N)) then
+         Assoc := First (Component_Associations (N));
+
+         --  Loop over associations to identify any iterated associations that
+         --  need to be converted from the form with a Defining_Identifer and
+         --  Discrete_Choices list to the form with an Iterator_Specification.
+
+         if Nkind (Assoc) = N_Iterated_Component_Association then
+            while Present (Assoc) loop
+               if Nkind (Assoc) = N_Iterated_Component_Association
+                 and then No (Iterator_Specification (Assoc))
+               then
+                  declare
+                     Choice : constant Node_Id :=
+                       First (Discrete_Choices (Assoc));
+                     Copy   : Node_Id;
+                  begin
+
+                     --  A copy of Choice is made before it's analyzed,
+                     --  to preserve prefixed calls in their original form,
+                     --  because otherwise the analysis of Choice can transform
+                     --  such calls to normal form, and the later analysis of
+                     --  the iterator_specification created below may trigger
+                     --  an error on the call (in the case where the function
+                     --  is not directly visible).
+
+                     Copy := Copy_Separate_Tree (Choice);
+
+                     --  This is an association with a Defining_Identifier and
+                     --  Discrete_Choice_List, but if the latter has a single
+                     --  choice denoting an object (including a function call)
+                     --  of an iterator type, then it's a stand-in for an
+                     --  Iterator_Specification, and so we transform the
+                     --  association accordingly.
+
+                     if No (Next (Choice)) then
+                        Analyze (Choice);
+
+                        if Is_Object_Reference (Choice)
+                          and then Is_Iterator (Etype (Choice))
+                        then
+                           Set_Iterator_Specification
+                             (Assoc,
+                              Make_Iterator_Specification (Sloc (N),
+                                Defining_Identifier =>
+                                  Relocate_Node (Defining_Identifier (Assoc)),
+                                Name                => Copy,
+                                Reverse_Present     => Reverse_Present (Assoc),
+                                Iterator_Filter     => Empty,
+                                Subtype_Indication  => Empty));
+
+                           Set_Defining_Identifier (Assoc, Empty);
+                           Set_Discrete_Choices (Assoc, No_List);
+                        end if;
+                     end if;
+                  end;
+               end if;
+
+               Next (Assoc);
+            end loop;
+         end if;
 
          --  Verify that all or none of the component associations
          --  include an iterator specification.
@@ -3814,7 +3874,7 @@ package body Sem_Aggr is
             then
                null;
 
-            elsif Nkind (Choice) = N_Function_Call then
+            elsif Is_Object_Reference (Choice) then
                declare
                   I_Spec : constant Node_Id :=
                     Make_Iterator_Specification (Sloc (N),
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 04/17] ada: Display actual line length in line length check
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 02/17] ada: First controlling parameter aspect Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 03/17] ada: Proper handling for iterator associations in array aggregates Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 05/17] ada: Ensure validity checks for private scalar types Marc Poulhiès
                   ` (12 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

gcc/ada/

	* styleg.adb (Check_Line_Max_Length): Add the actual line length
	to the diagnostic message.

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

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

diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index c405dec2b33..74b629c34b3 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -38,6 +38,7 @@ with Sinfo;          use Sinfo;
 with Sinfo.Nodes;    use Sinfo.Nodes;
 with Sinput;         use Sinput;
 with Stylesw;        use Stylesw;
+with Uintp;          use Uintp;
 
 package body Styleg is
 
@@ -672,8 +673,9 @@ package body Styleg is
    begin
       if Style_Check_Max_Line_Length then
          if Len > Style_Max_Line_Length then
+            Error_Msg_Uint_1 := UI_From_Int (Len);
             Error_Msg
-              ("(style) this line is too long?M?",
+              ("(style) this line is too long: ^?M?",
                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
          end if;
       end if;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 05/17] ada: Ensure validity checks for private scalar types
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (2 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 04/17] ada: Display actual line length in line length check Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 06/17] ada: Extract line fitting algorithm Marc Poulhiès
                   ` (11 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Piotr Trojanek

From: Piotr Trojanek <trojanek@adacore.com>

To check validity of data values, we must strip privacy from their
types.

gcc/ada/

	* checks.adb (Expr_Known_Valid): Use Validated_View, which strips
	type derivation and privacy.
	* exp_ch3.adb (Simple_Init_Private_Type): Kill checks inside
	unchecked conversions, just like in Simple_Init_Scalar_Type.

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

---
 gcc/ada/checks.adb  | 2 +-
 gcc/ada/exp_ch3.adb | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 83879a519f7..2fb750c3ba4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6833,7 +6833,7 @@ package body Checks is
    ----------------------
 
    function Expr_Known_Valid (Expr : Node_Id) return Boolean is
-      Typ : constant Entity_Id := Etype (Expr);
+      Typ : constant Entity_Id := Validated_View (Etype (Expr));
 
    begin
       --  Non-scalar types are always considered valid, since they never give
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bf04ea9d70a..4f6fa4cf6b7 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -10248,7 +10248,8 @@ package body Exp_Ch3 is
          if Nkind (Expr) = N_Unchecked_Type_Conversion
            and then Is_Scalar_Type (Under_Typ)
          then
-            Set_No_Truncation (Expr);
+            Set_Kill_Range_Check (Expr);
+            Set_No_Truncation    (Expr);
          end if;
 
          return Expr;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 06/17] ada: Extract line fitting algorithm
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (3 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 05/17] ada: Ensure validity checks for private scalar types Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 07/17] ada: Use consistent type continuations messages Marc Poulhiès
                   ` (10 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

Separate the line fitting algorithm from the general line
printing algorithm.

gcc/ada/

	* erroutc.ads: Add new method Output_Text_Within
	* erroutc.adb: Move the line fitting code to a new method called
	Output_Text_Within

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

---
 gcc/ada/erroutc.adb | 177 +++++++++++++++++++++++---------------------
 gcc/ada/erroutc.ads |   4 +
 2 files changed, 96 insertions(+), 85 deletions(-)

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 7a823cefe56..2ce3505959f 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -683,28 +683,106 @@ package body Erroutc is
       end if;
    end Output_Line_Number;
 
-   ---------------------
-   -- Output_Msg_Text --
-   ---------------------
+   ------------------------
+   -- Output_Text_Within --
+   ------------------------
 
-   procedure Output_Msg_Text (E : Error_Msg_Id) is
+   procedure Output_Text_Within (Txt : String_Ptr; Line_Length : Nat) is
       Offs : constant Nat := Column - 1;
       --  Offset to start of message, used for continuations
 
-      Max : Integer;
+      Ptr   : Natural;
+
+      Split : Natural;
+      --   Position where a new line was inserted in the original message
+
+      Start : Natural;
+      --   Start of the current line
+
+      Max   : Integer := Integer (Line_Length - Column + 1);
       --  Maximum characters to output on next line
 
-      Length : Nat;
-      --  Maximum total length of lines
+      Text_Length : constant Natural := Txt'Length;
+      --  Length of the message
+
+   begin
+      --  Here we have to split the message up into multiple lines
+
+      Ptr := 1;
+      loop
+         --  Make sure we do not have ludicrously small line
+
+         Max := Integer'Max (Max, 20);
+
+         --  If remaining text fits, output it respecting LF and we are done
+
+         if Text_Length - Ptr < Max then
+            for J in Ptr .. Text_Length loop
+               if Txt (J) = ASCII.LF then
+                  Write_Eol;
+                  Write_Spaces (Offs);
+               else
+                  Write_Char (Txt (J));
+               end if;
+            end loop;
+
+            return;
+
+         --  Line does not fit
+
+         else
+            Start := Ptr;
+
+            --  First scan forward looking for a hard end of line
+
+            for Scan in Ptr .. Ptr + Max - 1 loop
+               if Txt (Scan) = ASCII.LF then
+                  Split := Scan - 1;
+                  Ptr := Scan + 1;
+                  goto Continue;
+               end if;
+            end loop;
+
+            --  Otherwise scan backwards looking for a space
+
+            for Scan in reverse Ptr .. Ptr + Max - 1 loop
+               if Txt (Scan) = ' ' then
+                  Split := Scan - 1;
+                  Ptr := Scan + 1;
+                  goto Continue;
+               end if;
+            end loop;
+
+            --  If we fall through, no space, so split line arbitrarily
+
+            Split := Ptr + Max - 1;
+            Ptr := Split + 1;
+         end if;
+
+         <<Continue>>
+         if Start <= Split then
+            Write_Line (Txt (Start .. Split));
+            Write_Spaces (Offs);
+         end if;
+
+         Max := Integer (Line_Length - Column + 1);
+      end loop;
+   end Output_Text_Within;
+
+   ---------------------
+   -- Output_Msg_Text --
+   ---------------------
+
+   procedure Output_Msg_Text (E : Error_Msg_Id) is
 
       E_Msg : Error_Msg_Object renames Errors.Table (E);
       Text  : constant String_Ptr := E_Msg.Text;
-      Ptr   : Natural;
-      Split : Natural;
-      Start : Natural;
-      Tag : constant String := Get_Warning_Tag (E);
-      Txt : String_Ptr;
-      Len : Natural;
+      Tag   : constant String := Get_Warning_Tag (E);
+      Txt   : String_Ptr;
+
+      Line_Length : constant Nat :=
+        (if Error_Msg_Line_Length = 0 then Nat'Last
+         else Error_Msg_Line_Length);
 
    begin
       --  Postfix warning tag to message if needed
@@ -788,78 +866,7 @@ package body Erroutc is
          Txt := new String'(SGR_Error & "error: " & SGR_Reset & Txt.all);
       end if;
 
-      --  Set error message line length and length of message
-
-      if Error_Msg_Line_Length = 0 then
-         Length := Nat'Last;
-      else
-         Length := Error_Msg_Line_Length;
-      end if;
-
-      Max := Integer (Length - Column + 1);
-      Len := Txt'Length;
-
-      --  Here we have to split the message up into multiple lines
-
-      Ptr := 1;
-      loop
-         --  Make sure we do not have ludicrously small line
-
-         Max := Integer'Max (Max, 20);
-
-         --  If remaining text fits, output it respecting LF and we are done
-
-         if Len - Ptr < Max then
-            for J in Ptr .. Len loop
-               if Txt (J) = ASCII.LF then
-                  Write_Eol;
-                  Write_Spaces (Offs);
-               else
-                  Write_Char (Txt (J));
-               end if;
-            end loop;
-
-            return;
-
-         --  Line does not fit
-
-         else
-            Start := Ptr;
-
-            --  First scan forward looking for a hard end of line
-
-            for Scan in Ptr .. Ptr + Max - 1 loop
-               if Txt (Scan) = ASCII.LF then
-                  Split := Scan - 1;
-                  Ptr := Scan + 1;
-                  goto Continue;
-               end if;
-            end loop;
-
-            --  Otherwise scan backwards looking for a space
-
-            for Scan in reverse Ptr .. Ptr + Max - 1 loop
-               if Txt (Scan) = ' ' then
-                  Split := Scan - 1;
-                  Ptr := Scan + 1;
-                  goto Continue;
-               end if;
-            end loop;
-
-            --  If we fall through, no space, so split line arbitrarily
-
-            Split := Ptr + Max - 1;
-            Ptr := Split + 1;
-         end if;
-
-         <<Continue>>
-         if Start <= Split then
-            Write_Line (Txt (Start .. Split));
-            Write_Spaces (Offs);
-         end if;
-
-         Max := Integer (Length - Column + 1);
-      end loop;
+      Output_Text_Within (Txt, Line_Length);
    end Output_Msg_Text;
 
    ---------------------
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 5d48d5b899f..effc667bb5d 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -519,6 +519,10 @@ package Erroutc is
    --  splits the line generating multiple lines of output, and in this case
    --  the last line has no terminating end of line character.
 
+   procedure Output_Text_Within (Txt : String_Ptr; Line_Length : Nat);
+   --  Output the text in Txt, splitting it into lines of at most the size of
+   --  Line_Length.
+
    procedure Prescan_Message (Msg : String);
    --  Scans message text and sets the following variables:
    --
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 07/17] ada: Use consistent type continuations messages
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (4 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 06/17] ada: Extract line fitting algorithm Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 08/17] ada: Parse the attributes of continuation messages correctly Marc Poulhiès
                   ` (9 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

Avoid cases where the main message is an error and the
continuation is a warning.

gcc/ada/

	* freeze.adb: Remove warning insertion characters from a
	continuation message.
	* sem_util.adb: Remove warning insertion characters from a
	continuation message.
	* sem_warn.adb: Use same warning character as the main message.

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

---
 gcc/ada/freeze.adb   | 8 ++++----
 gcc/ada/sem_util.adb | 2 +-
 gcc/ada/sem_warn.adb | 6 +++---
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index f8e8cf38bb6..f7fc895055a 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3287,7 +3287,7 @@ package body Freeze is
                     ("aspect % applied to task type &", Typ);
                   Error_Msg_N
                     ("\replace task components with access-to-task-type "
-                     & "components??", Typ);
+                     & "components", Typ);
                end if;
 
             else
@@ -7617,16 +7617,16 @@ package body Freeze is
 
                if Ada_Version >= Ada_2005 then
                   Error_Msg_N
-                    ("\would be legal if Storage_Size of 0 given??", E);
+                    ("\would be legal if Storage_Size of 0 given", E);
 
                elsif No_Pool_Assigned (E) then
                   Error_Msg_N
-                    ("\would be legal in Ada 2005??", E);
+                    ("\would be legal in Ada 2005", E);
 
                else
                   Error_Msg_N
                     ("\would be legal in Ada 2005 if "
-                     & "Storage_Size of 0 given??", E);
+                     & "Storage_Size of 0 given", E);
                end if;
             end if;
          end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b423f87d969..ac64b1ca549 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5938,7 +5938,7 @@ package body Sem_Util is
                         else
                            Error_Msg
                              ("\Constraint_Error will be raised"
-                              & " for objects of this type??", Eloc, N);
+                              & " for objects of this type", Eloc, N);
                         end if;
                      end if;
                   end;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ca385154cb4..49e9d90b478 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3511,15 +3511,15 @@ package body Sem_Warn is
                      Error_Msg_Sloc := Sloc (CV);
 
                      if Nkind (CV) not in N_Subexpr then
-                        Error_Msg_N ("\\??(see test #)", N);
+                        Error_Msg_N ("\\?c?(see test #)", N);
 
                      elsif Nkind (Parent (CV)) =
                              N_Case_Statement_Alternative
                      then
-                        Error_Msg_N ("\\??(see case alternative #)", N);
+                        Error_Msg_N ("\\?c?(see case alternative #)", N);
 
                      else
-                        Error_Msg_N ("\\??(see assignment #)", N);
+                        Error_Msg_N ("\\?c?(see assignment #)", N);
                      end if;
                   end if;
                end;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 08/17] ada: Parse the attributes of continuation messages correctly
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (5 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 07/17] ada: Use consistent type continuations messages Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 09/17] ada: Avoid creating continuation messages without an intended parent Marc Poulhiès
                   ` (8 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

Currently unless pretty printing is enabled we avoid parsing
the message strings for continuation messages. This leads
to inconsistent state for the Error_Msg_Object-s that are
being created.

gcc/ada/

	* erroutc.adb (Prescan_Message): Avoid not parsing all of the
	message attributes.
	* erroutc.ads: Update the documentation.

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

---
 gcc/ada/erroutc.adb | 27 ++++++++++++++++++++++++---
 gcc/ada/erroutc.ads |  3 +--
 2 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 2ce3505959f..4e0a9f26e0d 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -922,15 +922,36 @@ package body Erroutc is
    --  Start of processing for Prescan_Message
 
    begin
-      --  Nothing to do for continuation line, unless -gnatdF is set
+      --  Continuation lines need to check only for insertion sequences.
+      --  Other attributes should be inherited from the main message.
+
+      if Msg (Msg'First) = '\' then
+         Has_Insertion_Line := False;
+
+         J := Msg'First;
+
+         --  If we have a quote, don't look at following character
+
+         while J <= Msg'Last loop
+            if Msg (J) = ''' then
+               J := J + 2;
+
+            --  Insertion line (# insertion)
+
+            elsif Msg (J) = '#' then
+               Has_Insertion_Line := True;
+               J := J + 1;
+            else
+               J := J + 1;
+            end if;
+         end loop;
 
-      if not Debug_Flag_FF and then Msg (Msg'First) = '\' then
          return;
 
       --  Some global variables are not set for continuation messages, as they
       --  only make sense for the initial message.
 
-      elsif Msg (Msg'First) /= '\' then
+      else
 
          --  Set initial values of globals (may be changed during scan)
 
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index effc667bb5d..0a52af5033c 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -555,8 +555,7 @@ package Erroutc is
    --  test these values before doing the full error scan.
    --
    --  Note that the call has no effect for continuation messages (those whose
-   --  first character is '\'), and all variables are left unchanged, unless
-   --  -gnatdF is set.
+   --  first character is '\') except for the Has_Insertion_Line setting.
 
    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
    --  All error messages whose location is in the range From .. To (not
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 09/17] ada: Avoid creating continuation messages without an intended parent
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (6 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 08/17] ada: Parse the attributes of continuation messages correctly Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 10/17] ada: Improve Inspection_Point warning Marc Poulhiès
                   ` (7 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

The messages modified in this patch do not have a clear intended
parent. This causes a lot of issues when grouping continuation
messages together with their parent. This can be confusing as it
is not obvious what was the parent message that caused this
problem or in worst case scenarios the message not being printed
alltogether.

These modified messages do not seem to be related to any concrete
error message and thus should be treated as independent messages.

gcc/ada/

	* sem_ch12.adb (Abandon_Instantiation): Remove continuation
	characters from the error message.
	* sem_ch13.adb (Check_False_Aspect_For_Derived_Type): Remove
	continuation characters from the error message.
	* sem_ch6.adb (Assert_False): Avoid creating a continuation
	message without a parent. If no primary message is created then
	the message is considered as primary.

gcc/testsuite/ChangeLog:

	* gnat.dg/interface6.adb: Adjust test.

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

---
 gcc/ada/sem_ch12.adb                 |  2 +-
 gcc/ada/sem_ch13.adb                 |  2 +-
 gcc/ada/sem_ch6.adb                  | 12 +++++++++---
 gcc/testsuite/gnat.dg/interface6.adb |  1 +
 4 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 686aa3208fb..b406cfce3b3 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2295,7 +2295,7 @@ package body Sem_Ch12 is
 
    procedure Abandon_Instantiation (N : Node_Id) is
    begin
-      Error_Msg_N ("\instantiation abandoned!", N);
+      Error_Msg_N ("instantiation abandoned!", N);
       raise Instantiation_Error;
    end Abandon_Instantiation;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a55ba3c7bd9..5cea155dc1e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1247,7 +1247,7 @@ package body Sem_Ch13 is
 
                      if Etype (Expression (ASN)) = Any_Type then
                         Error_Msg_NE
-                          ("\aspect must be fully defined before & is frozen",
+                          ("aspect must be fully defined before & is frozen",
                            ASN, E);
                      end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 461bdfcbe4b..86d784543f3 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7361,6 +7361,8 @@ package body Sem_Ch6 is
                   Error_Msg_N
                     ("implied return after this statement would have raised "
                      & "Program_Error", Last_Stm);
+                  Error_Msg_NE
+                    ("\procedure & is marked as No_Return!", Last_Stm, Proc);
 
                --  In normal compilation mode, do not warn on a generated call
                --  (e.g. in the body of a renaming as completion).
@@ -7369,11 +7371,15 @@ package body Sem_Ch6 is
                   Error_Msg_N
                     ("implied return after this statement will raise "
                      & "Program_Error??", Last_Stm);
+
+                  Error_Msg_NE
+                    ("\procedure & is marked as No_Return??!", Last_Stm, Proc);
+               else
+
+                  Error_Msg_NE
+                    ("procedure & is marked as No_Return!", Last_Stm, Proc);
                end if;
 
-               Error_Msg_Warn := SPARK_Mode /= On;
-               Error_Msg_NE
-                 ("\procedure & is marked as No_Return<<!", Last_Stm, Proc);
             end if;
 
             declare
diff --git a/gcc/testsuite/gnat.dg/interface6.adb b/gcc/testsuite/gnat.dg/interface6.adb
index 556a0b73c92..388b0090599 100644
--- a/gcc/testsuite/gnat.dg/interface6.adb
+++ b/gcc/testsuite/gnat.dg/interface6.adb
@@ -36,6 +36,7 @@ procedure Interface6 is
 
      procedure Test_Instance1 is new Test (T => Rec_Type);  --  { dg-error "actual must implement all interfaces of formal \"T\"" }
      procedure Test_Instance1 is new Test (T => Rec_Type1);  -- { dg-error "actual \"Rec_Type1\" must implement interface \"TI2\"" }
+     -- { dg-error "instantiation abandoned" "" { target *-*-* } 37 }
      procedure Test_Instance2 is new Test (T => Rec_Type2);
      procedure Test_Instance12 is new Test (T => Rec_Type12);
 
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 10/17] ada: Improve Inspection_Point warning
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (7 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 09/17] ada: Avoid creating continuation messages without an intended parent Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 11/17] ada: Restructure continuation message for pretty printing Marc Poulhiès
                   ` (6 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

Ensure that the primary and sub message point
to the same location in order to assure that the
submessages get pretty printed in the correct order.

gcc/ada/

	* exp_prag.adb (Expand_Pragma_Inspection_Point): Improve sub
	diagnostic generation.

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

---
 gcc/ada/exp_prag.adb | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 2c054d1b967..6c328ef36ce 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -2519,11 +2519,11 @@ package body Exp_Prag is
    procedure Expand_Pragma_Inspection_Point (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
-      A     : List_Id;
-      Assoc : Node_Id;
-      E     : Entity_Id;
-      Rip   : Boolean;
-      S     : Entity_Id;
+      A          : List_Id;
+      Assoc      : Node_Id;
+      Faulty_Arg : Node_Id := Empty;
+      E          : Entity_Id;
+      S          : Entity_Id;
 
    begin
       if No (Pragma_Argument_Associations (N)) then
@@ -2556,7 +2556,6 @@ package body Exp_Prag is
 
       --  Process the arguments of the pragma
 
-      Rip := False;
       Assoc := First (Pragma_Argument_Associations (N));
       while Present (Assoc) loop
          --  The back end may need to take the address of the object
@@ -2574,7 +2573,7 @@ package body Exp_Prag is
               ("??inspection point references unfrozen object &",
                Assoc,
                Entity (Expression (Assoc)));
-            Rip := True;
+            Faulty_Arg := Assoc;
          end if;
 
          Next (Assoc);
@@ -2582,8 +2581,10 @@ package body Exp_Prag is
 
       --  When the above requirement isn't met, turn the pragma into a no-op
 
-      if Rip then
-         Error_Msg_N ("\pragma will be ignored", N);
+      if Present (Faulty_Arg) then
+         Error_Msg_Sloc := Sloc (Faulty_Arg);
+         Error_Msg_N ("\pragma Inspection_Point # will be ignored",
+           Faulty_Arg);
 
          --  We can't just remove the pragma from the tree as it might be
          --  iterated over by the caller. Turn it into a null statement
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 11/17] ada: Restructure continuation message for pretty printing
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (8 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 10/17] ada: Improve Inspection_Point warning Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 12/17] ada: Use the same warning character in continuation messages Marc Poulhiès
                   ` (5 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

Continuation messages should have the same location
as the main message. If the goal is to point to a different
location then Error_Msg_Sloc should be used to change
the location of the continuation message.

gcc/ada/

	* par-ch4.adb (P_Name): Use Error_Msg_Sloc for the location of the
	continuation message.

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

---
 gcc/ada/par-ch4.adb | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 8b491c2cfd7..e76b0d8bea6 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -218,6 +218,8 @@ package body Ch4 is
       Arg_List  : List_Id := No_List; -- kill junk warning
       Attr_Name : Name_Id := No_Name; -- kill junk warning
 
+      Error_Loc : Source_Ptr;
+
    begin
       --  Case of not a name
 
@@ -889,13 +891,16 @@ package body Ch4 is
          ("positional parameter association " &
            "not allowed after named one");
 
+      Error_Loc := Token_Ptr;
+
       Expr_Node := P_Expression_If_OK;
 
       --  Leaving the '>' in an association is not unusual, so suggest
       --  a possible fix.
 
       if Nkind (Expr_Node) = N_Op_Eq then
-         Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
+         Error_Msg_Sloc := Sloc (Expr_Node);
+         Error_Msg ("\maybe `='>` was intended #", Error_Loc);
       end if;
 
       --  We go back to scanning out expressions, so that we do not get
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 12/17] ada: Use the same warning character in continuation messages
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (9 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 11/17] ada: Restructure continuation message for pretty printing Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 13/17] ada: Print Insertion_Sloc in dmsg Marc Poulhiès
                   ` (4 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

For consitency sake the main and continuation messages should
use the same warning characters.

gcc/ada/

	* exp_aggr.adb (Expand_Range_Component): Remove extra warning
	character. Use same conditional warning char.
	* freeze.adb (Warn_Overlay): Use named warning character.
	* restrict.adb (Id_Case): Use named warning character.
	* sem_prag.adb (Rewrite_Assertion_Kind): Use default warning
	character.

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

---
 gcc/ada/exp_aggr.adb | 4 ++--
 gcc/ada/freeze.adb   | 4 ++--
 gcc/ada/restrict.adb | 2 +-
 gcc/ada/sem_prag.adb | 2 +-
 4 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 83b88e7cf73..846665eae20 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7276,9 +7276,9 @@ package body Exp_Aggr is
          Error_Msg_Warn := SPARK_Mode /= On;
          Error_Msg_N
            ("!empty aggregate returned by the empty function of a container"
-            & " aggregate<<<", Parent (N));
+            & " aggregate<<", Parent (N));
          Error_Msg_N
-           ("\this will result in infinite recursion??", Parent (N));
+           ("\this will result in infinite recursion<<", Parent (N));
       end if;
 
       ---------------------------
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index f7fc895055a..882c026455e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -11100,7 +11100,7 @@ package body Freeze is
                   then
                      Error_Msg_NE
                        ("\packed array component& " &
-                        "will be initialized to zero??",
+                        "will be initialized to zero?o?",
                         Nam, Comp);
                      exit;
                   else
@@ -11112,7 +11112,7 @@ package body Freeze is
 
          Error_Msg_N
            ("\use pragma Import for & to " &
-            "suppress initialization (RM B.1(24))??",
+            "suppress initialization (RM B.1(24))?o?",
             Nam);
       end if;
    end Warn_Overlay;
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index bda35d8f441..2e3cdde3d6e 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -1262,7 +1262,7 @@ package body Restrict is
          --  Set as warning if warning case
 
          if Restriction_Warnings (R) then
-            Add_Str ("??");
+            Add_Str ("?*?");
          end if;
 
          --  Set main message
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 87922816a9a..b139bd4cf4e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -33719,7 +33719,7 @@ package body Sem_Prag is
             Error_Msg_N ("Check_Policy is a non-standard pragma??", N);
             Error_Msg_N
               ("\use Assertion_Policy and aspect names Pre/Post for "
-               & "Ada2012 conformance?", N);
+               & "Ada2012 conformance??", N);
          end if;
 
          return;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 13/17] ada: Print Insertion_Sloc in dmsg
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (10 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 12/17] ada: Use the same warning character in continuation messages Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 14/17] ada: Fix missing finalization for call to function returning limited view Marc Poulhiès
                   ` (3 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Viljar Indus

From: Viljar Indus <indus@adacore.com>

gcc/ada/

	* erroutc.adb (dmsg): Print Insertion_Sloc.

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

---
 gcc/ada/erroutc.adb | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 4e0a9f26e0d..db1c0923e90 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -327,6 +327,11 @@ package body Erroutc is
       Write_Location (E.Optr.Ptr);
       Write_Eol;
 
+      Write_Str
+        ("  Insertion_Sloc     = ");
+      Write_Location (E.Insertion_Sloc);
+      Write_Eol;
+
       w ("  Line               = ", Int (E.Line));
       w ("  Col                = ", Int (E.Col));
       w ("  Info               = ", E.Info);
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 14/17] ada: Fix missing finalization for call to function returning limited view
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (11 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 13/17] ada: Print Insertion_Sloc in dmsg Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 15/17] ada: Missing legality check when type completed Marc Poulhiès
                   ` (2 subsequent siblings)
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

From: Eric Botcazou <ebotcazou@adacore.com>

The call is legal because it is made from the body, which has visibility on
the nonlimited view, so this changes the code in Expand_Call_Helper to look
at the Etype of the call node instead of the Etype of the function.

gcc/ada/

	* exp_ch6.adb (Expand_Call_Helper): In the case of a function
	call, look at the Etype of the call node to determine whether
	finalization actions need to be performed.

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

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

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 420d5f44a69..3c87c0e8220 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5262,7 +5262,9 @@ package body Exp_Ch6 is
       --  function call is transformed into a reference to the result that has
       --  been built either on the primary or the secondary stack.
 
-      if Needs_Finalization (Etype (Subp)) then
+      if Nkind (Call_Node) = N_Function_Call
+        and then Needs_Finalization (Etype (Call_Node))
+      then
          if not Is_Build_In_Place_Function_Call (Call_Node)
            and then
              (No (First_Formal (Subp))
@@ -5270,7 +5272,7 @@ package body Exp_Ch6 is
                  not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
          then
             Expand_Ctrl_Function_Call
-              (Call_Node, Needs_Secondary_Stack (Etype (Subp)));
+              (Call_Node, Needs_Secondary_Stack (Etype (Call_Node)));
 
          --  Build-in-place function calls which appear in anonymous contexts
          --  need a transient scope to ensure the proper finalization of the
@@ -5292,7 +5294,7 @@ package body Exp_Ch6 is
                  Is_Build_In_Place_Function_Call (Parent (Call_Node)))
          then
             Establish_Transient_Scope
-              (Call_Node, Needs_Secondary_Stack (Etype (Subp)));
+              (Call_Node, Needs_Secondary_Stack (Etype (Call_Node)));
          end if;
       end if;
    end Expand_Call_Helper;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 15/17] ada: Missing legality check when type completed
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (12 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 14/17] ada: Fix missing finalization for call to function returning limited view Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 16/17] ada: Fix internal error on concatenation of discriminant-dependent component Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 17/17] ada: Fix assertion failure on private limited with clause Marc Poulhiès
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Steve Baird

From: Steve Baird <baird@adacore.com>

Refine previous fix to better handle tagged cases.

gcc/ada/

	* sem_ch6.adb (Check_Discriminant_Conformance): Immediately after
	calling Is_Immutably_Limited_Type, perform an additional test that
	one might reasonably imagine would instead have been part of
	Is_Immutably_Limited_Type. The new test is a call to a new
	function Has_Tagged_Limited_Partial_View whose implementation
	includes a call to Incomplete_Or_Partial_View, which cannot be
	easily be called from Is_Immutably_Limited_Type (because sem_aux,
	which is in the closure of the binder, cannot easily "with"
	sem_util).
	* sem_aux.adb (Is_Immutably_Limited): Include
	N_Derived_Type_Definition case when testing Limited_Present flag.

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

---
 gcc/ada/sem_aux.adb |  8 ++++----
 gcc/ada/sem_ch6.adb | 26 ++++++++++++++++++++++++++
 2 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 9903a2b6a16..5edf6675474 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1118,12 +1118,12 @@ package body Sem_Aux is
 
       elsif Is_Private_Type (Btype) then
 
-      --  If Ent occurs in the completion of a limited private type, then
-      --  look for the word "limited" in the full view.
+         --  If Ent occurs in the completion of a private type, then
+         --  look for the word "limited" in the full view.
 
          if Nkind (Parent (Ent)) = N_Full_Type_Declaration
-           and then Nkind (Type_Definition (Parent (Ent))) =
-                      N_Record_Definition
+           and then Nkind (Type_Definition (Parent (Ent))) in
+                      N_Record_Definition | N_Derived_Type_Definition
            and then Limited_Present (Type_Definition (Parent (Ent)))
          then
             return True;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 86d784543f3..076fb89c7b5 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6432,6 +6432,25 @@ package body Sem_Ch6 is
             OldD : constant Boolean :=
                      Present (Expression (Parent (Old_Discr)));
 
+            function Has_Tagged_Limited_Partial_View
+              (Typ : Entity_Id) return Boolean;
+            --  Returns True iff Typ has a tagged limited partial view.
+
+            -------------------------------------
+            -- Has_Tagged_Limited_Partial_View --
+            -------------------------------------
+
+            function Has_Tagged_Limited_Partial_View
+              (Typ : Entity_Id) return Boolean
+            is
+               Priv : constant Entity_Id := Incomplete_Or_Partial_View (Typ);
+            begin
+               return Present (Priv)
+                 and then not Is_Incomplete_Type (Priv)
+                 and then Is_Tagged_Type (Priv)
+                 and then Limited_Present (Parent (Priv));
+            end Has_Tagged_Limited_Partial_View;
+
          begin
             if NewD or OldD then
 
@@ -6463,6 +6482,13 @@ package body Sem_Ch6 is
                             N_Access_Definition
                  and then not Is_Immutably_Limited_Type
                                 (Defining_Identifier (N))
+
+                 --  Check for a case that would be awkward to handle in
+                 --  Is_Immutably_Limited_Type (because sem_aux can't
+                 --  "with" sem_util).
+
+                 and then not Has_Tagged_Limited_Partial_View
+                                (Defining_Identifier (N))
                then
                   Error_Msg_N
                     ("(Ada 2005) default value for access discriminant "
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 16/17] ada: Fix internal error on concatenation of discriminant-dependent component
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (13 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 15/17] ada: Missing legality check when type completed Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  2024-08-29 13:07 ` [COMMITTED 17/17] ada: Fix assertion failure on private limited with clause Marc Poulhiès
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

From: Eric Botcazou <ebotcazou@adacore.com>

This only occurs with optimization enabled, but the expanded code is always
wrong because it reuses the formal parameter of an initialization procedure
associated with a discriminant (a discriminal in GNAT parlance) outside of
the initialization procedure.

gcc/ada/

	* checks.adb (Selected_Length_Checks.Get_E_Length): For a
	component of a record with discriminants and if the expression is
	a selected component, try to build an actual subtype from its
	prefix instead of from the discriminal.

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

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

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 2fb750c3ba4..5d7f4cca70a 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -9861,7 +9861,15 @@ package body Checks is
          if Ekind (Scope (E)) = E_Record_Type
            and then Has_Discriminants (Scope (E))
          then
-            N := Build_Discriminal_Subtype_Of_Component (E);
+            --  If the expression is a selected component, in other words,
+            --  has a prefix, then build an actual subtype from the prefix.
+            --  Otherwise, build an actual subtype from the discriminal.
+
+            if Nkind (Expr) = N_Selected_Component then
+               N := Build_Actual_Subtype_Of_Component (E, Expr);
+            else
+               N := Build_Discriminal_Subtype_Of_Component (E);
+            end if;
 
             if Present (N) then
                Insert_Action (Expr, N);
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

* [COMMITTED 17/17] ada: Fix assertion failure on private limited with clause
  2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
                   ` (14 preceding siblings ...)
  2024-08-29 13:07 ` [COMMITTED 16/17] ada: Fix internal error on concatenation of discriminant-dependent component Marc Poulhiès
@ 2024-08-29 13:07 ` Marc Poulhiès
  15 siblings, 0 replies; 17+ messages in thread
From: Marc Poulhiès @ 2024-08-29 13:07 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

From: Eric Botcazou <ebotcazou@adacore.com>

This checks that the name is of an entity before accessing its Entity field.

gcc/ada/

	* sem_ch8.adb (Has_Private_With): Add test on Is_Entity_Name.

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

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

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 99060061471..13c44c5e302 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -8980,6 +8980,7 @@ package body Sem_Ch8 is
       while Present (Item) loop
          if Nkind (Item) = N_With_Clause
            and then Private_Present (Item)
+           and then Is_Entity_Name (Name (Item))
            and then Entity (Name (Item)) = E
          then
             return True;
-- 
2.45.2


^ permalink raw reply	[flat|nested] 17+ messages in thread

end of thread, other threads:[~2024-08-29 13:08 UTC | newest]

Thread overview: 17+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-08-29 13:07 [COMMITTED 01/17] ada: Update documentation for conditional when constructs Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 02/17] ada: First controlling parameter aspect Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 03/17] ada: Proper handling for iterator associations in array aggregates Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 04/17] ada: Display actual line length in line length check Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 05/17] ada: Ensure validity checks for private scalar types Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 06/17] ada: Extract line fitting algorithm Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 07/17] ada: Use consistent type continuations messages Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 08/17] ada: Parse the attributes of continuation messages correctly Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 09/17] ada: Avoid creating continuation messages without an intended parent Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 10/17] ada: Improve Inspection_Point warning Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 11/17] ada: Restructure continuation message for pretty printing Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 12/17] ada: Use the same warning character in continuation messages Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 13/17] ada: Print Insertion_Sloc in dmsg Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 14/17] ada: Fix missing finalization for call to function returning limited view Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 15/17] ada: Missing legality check when type completed Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 16/17] ada: Fix internal error on concatenation of discriminant-dependent component Marc Poulhiès
2024-08-29 13:07 ` [COMMITTED 17/17] ada: Fix assertion failure on private limited with clause Marc Poulhiès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).