mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-02 08:40:26 +08:00
ada: Allow enabling a restricted set of language extensions.
The -gnatX switch (and the related Extensions_Allowed pragma) is currently a two-valued all-or-nothing option. Add support for enabling a curated subset of language extensions without enabling others via the -gnatX switch and for enabling all language extensions via the new -gnatX0 switch. Similarly, the existing "ON" argument for the Extensions_Allowed pragma now only enables the curated subset; the new argument "ALL" enables all language extensions. The subset of language extensions currently includes prefixed-view notation with an untagged prefix, fixed-low-bound array subtypes, and casing on composite values. gcc/ada/ * opt.ads: Replace Ada_Version_Type enumeration literal Ada_With_Extensions with two literals, Ada_With_Core_Extensions and Ada_With_All_Extensions. Update uses of the deleted literal. Replace Extensions_Allowed function with two functions: All_Extensions_Allowed and Core_Extensions_Allowed. * errout.ads, errout.adb: Add Boolean parameter to Error_Msg_GNAT_Extension to indicate whether the construct in question belongs to the curated subset. * exp_ch5.adb, par-ch4.adb, sem_case.adb, sem_ch3.adb: * sem_ch4.adb, sem_ch5.adb, sem_ch8.adb: Replace calls to Extensions_Allowed with calls to Core_Extensions_Allowed for constructs that are in the curated subset. * sem_attr.adb, sem_ch13.adb, sem_eval.adb, sem_util.adb: Replace calls to Extensions_Allowed with calls to All_Extensions_Allowed for constructs that are not in the curated subset. * par-ch3.adb: Override default for new parameter in calls to Error_Msg_GNAT_Extension for constructs in the curated subset. * par-prag.adb: Add Boolean parameter to Check_Arg_Is_On_Or_Off to also allow ALL. Set Opt.Ada_Version appropriately for ALL or ON arguments. * sem_prag.adb: Allowed ALL argument for an Extensions_Allowed pragma. Set Opt.Ada_Version appropriately for ALL or ON arguments. * switch-c.adb: The -gnatX switch now enables only the curated subset of language extensions (formerly it enabled all of them); the new -gnatX0 switch enables all of them. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Document new "-gnatX0" switch and update documentation for "-gnatX" switch. * doc/gnat_rm/implementation_defined_pragmas.rst: Document new ALL argument for pragma Extensions_Allowed and update documentation for the ON argument. Delete mention of Ada 2022 Reduce attribute as an extension. * gnat_rm.texi, gnat_ugn.texi: Regenerate.
This commit is contained in:
parent
c07da8567b
commit
1e78b49adb
@ -2174,16 +2174,19 @@ Syntax:
|
||||
|
||||
.. code-block:: ada
|
||||
|
||||
pragma Extensions_Allowed (On | Off);
|
||||
pragma Extensions_Allowed (On | Off | All);
|
||||
|
||||
|
||||
This configuration pragma enables or disables the implementation
|
||||
extension mode (the use of Off as a parameter cancels the effect
|
||||
of the *-gnatX* command switch).
|
||||
This configuration pragma enables (via the "On" or "All" argument) or disables
|
||||
(via the "Off" argument) the implementation extension mode; the pragma takes
|
||||
precedence over the *-gnatX* and *-gnatX0* command switches.
|
||||
|
||||
In extension mode, the latest version of the Ada language is
|
||||
implemented (currently Ada 2022), and in addition a number
|
||||
of GNAT specific extensions are recognized as follows:
|
||||
If an argument of "All" is specified, the latest version of the Ada language
|
||||
is implemented (currently Ada 2022) and, in addition, a number
|
||||
of GNAT specific extensions are recognized. These extensions are listed
|
||||
below. An argument of "On" has the same effect except that only
|
||||
some, not all, of the listed extensions are enabled; those extensions
|
||||
are identified below.
|
||||
|
||||
* Constrained attribute for generic objects
|
||||
|
||||
@ -2197,11 +2200,6 @@ of GNAT specific extensions are recognized as follows:
|
||||
functions and the compiler will evaluate some of these intrinsic statically,
|
||||
in particular the ``Shift_Left`` and ``Shift_Right`` intrinsics.
|
||||
|
||||
* ``'Reduce`` attribute
|
||||
|
||||
This attribute part of the Ada 202x language definition is provided for
|
||||
now under -gnatX to confirm and potentially refine its usage and syntax.
|
||||
|
||||
* ``[]`` aggregates
|
||||
|
||||
This new aggregate syntax for arrays and containers is provided under -gnatX
|
||||
@ -2334,6 +2332,8 @@ of GNAT specific extensions are recognized as follows:
|
||||
for a given identifer must all statically match. Currently, the case
|
||||
of a binding for a nondiscrete component is not implemented.
|
||||
|
||||
An Extensions_Allowed pragma argument of "On" enables this extension.
|
||||
|
||||
* Fixed lower bounds for array types and subtypes
|
||||
|
||||
Unconstrained array types and subtypes can be specified with a lower bound
|
||||
@ -2378,6 +2378,8 @@ of GNAT specific extensions are recognized as follows:
|
||||
knows the lower bound of unconstrained array formals when the formal's
|
||||
subtype has index ranges with static fixed lower bounds.
|
||||
|
||||
An Extensions_Allowed pragma argument of "On" enables this extension.
|
||||
|
||||
* Prefixed-view notation for calls to primitive subprograms of untagged types
|
||||
|
||||
Since Ada 2005, calls to primitive subprograms of a tagged type that
|
||||
@ -2395,6 +2397,8 @@ of GNAT specific extensions are recognized as follows:
|
||||
name, preference is given to the component in a selected_component
|
||||
(as is currently the case for tagged types with such component names).
|
||||
|
||||
An Extensions_Allowed pragma argument of "On" enables this extension.
|
||||
|
||||
* Expression defaults for generic formal functions
|
||||
|
||||
The declaration of a generic formal function is allowed to specify
|
||||
|
@ -2180,7 +2180,13 @@ Alphabetical List of All Switches
|
||||
.. index:: -gnatX (gcc)
|
||||
|
||||
:switch:`-gnatX`
|
||||
Enable GNAT implementation extensions and latest Ada version.
|
||||
Enable core GNAT implementation extensions and latest Ada version.
|
||||
|
||||
|
||||
.. index:: -gnatX0 (gcc)
|
||||
|
||||
:switch:`-gnatX0`
|
||||
Enable all GNAT implementation extensions and latest Ada version.
|
||||
|
||||
|
||||
.. index:: -gnaty (gcc)
|
||||
@ -5585,16 +5591,27 @@ indicate Ada 83 compatibility mode.
|
||||
language.
|
||||
|
||||
|
||||
.. index:: -gnatX (gcc)
|
||||
.. index:: -gnatX0 (gcc)
|
||||
.. index:: Ada language extensions
|
||||
.. index:: GNAT extensions
|
||||
|
||||
:switch:`-gnatX` (Enable GNAT Extensions)
|
||||
:switch:`-gnatX0` (Enable GNAT Extensions)
|
||||
This switch directs the compiler to implement the latest version of the
|
||||
language (currently Ada 2022) and also to enable certain GNAT implementation
|
||||
extensions that are not part of any Ada standard. For a full list of these
|
||||
extensions, see the GNAT reference manual, ``Pragma Extensions_Allowed``.
|
||||
|
||||
.. index:: -gnatX (gcc)
|
||||
.. index:: Ada language extensions
|
||||
.. index:: GNAT extensions
|
||||
|
||||
:switch:`-gnatX` (Enable core GNAT Extensions)
|
||||
This switch is similar to -gnatX0 except that only some, not all, of the
|
||||
GNAT-defined language extensions are enabled. For a list of the
|
||||
extensions enabled by this switch, see the GNAT reference manual
|
||||
``Pragma Extensions_Allowed`` and the description of that pragma's
|
||||
"On" (as opposed to "All") argument.
|
||||
|
||||
|
||||
.. _Character_Set_Control:
|
||||
|
||||
|
@ -881,18 +881,40 @@ package body Errout is
|
||||
-- Error_Msg_GNAT_Extension --
|
||||
------------------------------
|
||||
|
||||
procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr) is
|
||||
procedure Error_Msg_GNAT_Extension
|
||||
(Extension : String;
|
||||
Loc : Source_Ptr;
|
||||
Is_Core_Extension : Boolean := False)
|
||||
is
|
||||
begin
|
||||
if not Extensions_Allowed then
|
||||
Error_Msg (Extension & " is a 'G'N'A'T-specific extension", Loc);
|
||||
if (if Is_Core_Extension
|
||||
then Core_Extensions_Allowed
|
||||
else All_Extensions_Allowed)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if No (Ada_Version_Pragma) then
|
||||
Error_Msg ("\unit must be compiled with -gnatX "
|
||||
& "or use pragma Extensions_Allowed (On)", Loc);
|
||||
Error_Msg (Extension & " is a 'G'N'A'T-specific extension", Loc);
|
||||
|
||||
if No (Ada_Version_Pragma) then
|
||||
if Is_Core_Extension then
|
||||
Error_Msg
|
||||
("\unit must be compiled with -gnatX '[or -gnatX0'] " &
|
||||
"or use pragma Extensions_Allowed (On) '[or All']", Loc);
|
||||
else
|
||||
Error_Msg_Sloc := Sloc (Ada_Version_Pragma);
|
||||
Error_Msg ("\incompatible with Ada version set#", Loc);
|
||||
Error_Msg ("\must use pragma Extensions_Allowed (On)", Loc);
|
||||
Error_Msg
|
||||
("\unit must be compiled with -gnatX0 " &
|
||||
"or use pragma Extensions_Allowed (All)", Loc);
|
||||
end if;
|
||||
else
|
||||
Error_Msg_Sloc := Sloc (Ada_Version_Pragma);
|
||||
Error_Msg ("\incompatible with Ada version set#", Loc);
|
||||
if Is_Core_Extension then
|
||||
Error_Msg
|
||||
("\must use pragma Extensions_Allowed (On) '[or All']", Loc);
|
||||
else
|
||||
Error_Msg
|
||||
("\must use pragma Extensions_Allowed (All)", Loc);
|
||||
end if;
|
||||
end if;
|
||||
end Error_Msg_GNAT_Extension;
|
||||
|
@ -937,11 +937,18 @@ package Errout is
|
||||
procedure Error_Msg_Ada_2022_Feature (Feature : String; Loc : Source_Ptr);
|
||||
-- Analogous to Error_Msg_Ada_2012_Feature, for Ada 2022
|
||||
|
||||
procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr);
|
||||
-- If not operating with extensions allowed, posts errors complaining
|
||||
-- that Extension is only supported when the -gnatX switch is enabled
|
||||
-- or pragma Extensions_Allowed (On) is used. Loc indicates the source
|
||||
-- location of the extension construct.
|
||||
procedure Error_Msg_GNAT_Extension
|
||||
(Extension : String;
|
||||
Loc : Source_Ptr;
|
||||
Is_Core_Extension : Boolean := False);
|
||||
-- To be called as part of checking a GNAT language extension (either a
|
||||
-- core extension or not, as indicated by the Is_Core_Extension parameter).
|
||||
-- If switch -gnatX0 or pragma Extension_Allowed (All) is in effect, then
|
||||
-- either kind of extension is allowed; if switch -gnatX or pragma
|
||||
-- Extensions_Allowed (On) is in effect, then only core extensions are
|
||||
-- allowed. Otherwise, no extensions are allowed. A disallowed construct
|
||||
-- is flagged as an error. Loc indicates the source location of the
|
||||
-- extension construct.
|
||||
|
||||
procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg;
|
||||
-- Debugging routine to dump an error message
|
||||
|
@ -3939,7 +3939,9 @@ package body Exp_Ch5 is
|
||||
-- Start of processing for Expand_N_Case_Statement
|
||||
|
||||
begin
|
||||
if Extensions_Allowed and then not Is_Discrete_Type (Etype (Expr)) then
|
||||
if Core_Extensions_Allowed
|
||||
and then not Is_Discrete_Type (Etype (Expr))
|
||||
then
|
||||
Rewrite (N, Expand_General_Case_Statement);
|
||||
Analyze (N);
|
||||
return;
|
||||
|
@ -3608,16 +3608,19 @@ GNAT User’s Guide.
|
||||
Syntax:
|
||||
|
||||
@example
|
||||
pragma Extensions_Allowed (On | Off);
|
||||
pragma Extensions_Allowed (On | Off | All);
|
||||
@end example
|
||||
|
||||
This configuration pragma enables or disables the implementation
|
||||
extension mode (the use of Off as a parameter cancels the effect
|
||||
of the `-gnatX' command switch).
|
||||
This configuration pragma enables (via the “On” or “All” argument) or disables
|
||||
(via the “Off” argument) the implementation extension mode; the pragma takes
|
||||
precedence over the `-gnatX' and `-gnatX0' command switches.
|
||||
|
||||
In extension mode, the latest version of the Ada language is
|
||||
implemented (currently Ada 2022), and in addition a number
|
||||
of GNAT specific extensions are recognized as follows:
|
||||
If an argument of “All” is specified, the latest version of the Ada language
|
||||
is implemented (currently Ada 2022) and, in addition, a number
|
||||
of GNAT specific extensions are recognized. These extensions are listed
|
||||
below. An argument of “On” has the same effect except that only
|
||||
some, not all, of the listed extensions are enabled; those extensions
|
||||
are identified below.
|
||||
|
||||
|
||||
@itemize *
|
||||
@ -3636,12 +3639,6 @@ The Ada 202x @code{Static} aspect can be specified on Intrinsic imported
|
||||
functions and the compiler will evaluate some of these intrinsic statically,
|
||||
in particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
|
||||
|
||||
@item
|
||||
@code{'Reduce} attribute
|
||||
|
||||
This attribute part of the Ada 202x language definition is provided for
|
||||
now under -gnatX to confirm and potentially refine its usage and syntax.
|
||||
|
||||
@item
|
||||
@code{[]} aggregates
|
||||
|
||||
@ -3785,6 +3782,8 @@ define the same set of bindings and the component subtypes for
|
||||
for a given identifer must all statically match. Currently, the case
|
||||
of a binding for a nondiscrete component is not implemented.
|
||||
|
||||
An Extensions_Allowed pragma argument of “On” enables this extension.
|
||||
|
||||
@item
|
||||
Fixed lower bounds for array types and subtypes
|
||||
|
||||
@ -3833,6 +3832,8 @@ improve the efficiency of indexing operations, since the compiler statically
|
||||
knows the lower bound of unconstrained array formals when the formal’s
|
||||
subtype has index ranges with static fixed lower bounds.
|
||||
|
||||
An Extensions_Allowed pragma argument of “On” enables this extension.
|
||||
|
||||
@item
|
||||
Prefixed-view notation for calls to primitive subprograms of untagged types
|
||||
|
||||
@ -3851,6 +3852,8 @@ component is visible at the point of a selected_component using that
|
||||
name, preference is given to the component in a selected_component
|
||||
(as is currently the case for tagged types with such component names).
|
||||
|
||||
An Extensions_Allowed pragma argument of “On” enables this extension.
|
||||
|
||||
@item
|
||||
Expression defaults for generic formal functions
|
||||
|
||||
|
@ -9881,7 +9881,17 @@ Suppress generation of cross-reference information.
|
||||
|
||||
@item @code{-gnatX}
|
||||
|
||||
Enable GNAT implementation extensions and latest Ada version.
|
||||
Enable core GNAT implementation extensions and latest Ada version.
|
||||
@end table
|
||||
|
||||
@geindex -gnatX0 (gcc)
|
||||
|
||||
|
||||
@table @asis
|
||||
|
||||
@item @code{-gnatX0}
|
||||
|
||||
Enable all GNAT implementation extensions and latest Ada version.
|
||||
@end table
|
||||
|
||||
@geindex -gnaty (gcc)
|
||||
@ -14416,6 +14426,23 @@ This switch directs the compiler to implement the Ada 2022 version of the
|
||||
language.
|
||||
@end table
|
||||
|
||||
@geindex -gnatX0 (gcc)
|
||||
|
||||
@geindex Ada language extensions
|
||||
|
||||
@geindex GNAT extensions
|
||||
|
||||
|
||||
@table @asis
|
||||
|
||||
@item @code{-gnatX0} (Enable GNAT Extensions)
|
||||
|
||||
This switch directs the compiler to implement the latest version of the
|
||||
language (currently Ada 2022) and also to enable certain GNAT implementation
|
||||
extensions that are not part of any Ada standard. For a full list of these
|
||||
extensions, see the GNAT reference manual, @code{Pragma Extensions_Allowed}.
|
||||
@end table
|
||||
|
||||
@geindex -gnatX (gcc)
|
||||
|
||||
@geindex Ada language extensions
|
||||
@ -14425,12 +14452,13 @@ language.
|
||||
|
||||
@table @asis
|
||||
|
||||
@item @code{-gnatX} (Enable GNAT Extensions)
|
||||
@item @code{-gnatX} (Enable core GNAT Extensions)
|
||||
|
||||
This switch directs the compiler to implement the latest version of the
|
||||
language (currently Ada 2022) and also to enable certain GNAT implementation
|
||||
extensions that are not part of any Ada standard. For a full list of these
|
||||
extensions, see the GNAT reference manual, @code{Pragma Extensions_Allowed}.
|
||||
This switch is similar to -gnatX0 except that only some, not all, of the
|
||||
GNAT-defined language extensions are enabled. For a list of the
|
||||
extensions enabled by this switch, see the GNAT reference manual
|
||||
@code{Pragma Extensions_Allowed} and the description of that pragma’s
|
||||
“On” (as opposed to “All”) argument.
|
||||
@end table
|
||||
|
||||
@node Character Set Control,File Naming Control,Compiling Different Versions of Ada,Compiler Switches
|
||||
|
@ -73,15 +73,16 @@ package Opt is
|
||||
-- Ada_xxx) or generate an error (in case of -gnat83/95/xx switches).
|
||||
|
||||
type Ada_Version_Type is
|
||||
(Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2022, Ada_With_Extensions);
|
||||
(Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2022,
|
||||
Ada_With_Core_Extensions, Ada_With_All_Extensions);
|
||||
pragma Ordered (Ada_Version_Type);
|
||||
pragma Convention (C, Ada_Version_Type);
|
||||
-- Versions of Ada for Ada_Version below. Note that these are ordered,
|
||||
-- so that tests like Ada_Version >= Ada_95 are legitimate and useful.
|
||||
-- Think twice before using "="; Ada_Version >= Ada_2012 is more likely
|
||||
-- what you want, because it will apply to future versions of the language.
|
||||
-- Note that Ada_With_Extensions should always be last since it should
|
||||
-- always be a superset of the latest Ada version.
|
||||
-- Note that Ada_With_All_Extensions should always be last since it should
|
||||
-- always be a superset of the other Ada versions.
|
||||
|
||||
-- WARNING: There is a matching C declaration of this type in fe.h
|
||||
|
||||
@ -111,7 +112,7 @@ package Opt is
|
||||
-- remains set to Ada_Version_Default). This is used in the rare cases
|
||||
-- (notably pragma Obsolescent) where we want the explicit version set.
|
||||
|
||||
Ada_Version_Runtime : Ada_Version_Type := Ada_With_Extensions;
|
||||
Ada_Version_Runtime : Ada_Version_Type := Ada_With_All_Extensions;
|
||||
-- GNAT
|
||||
-- Ada version used to compile the runtime. Used to set Ada_Version (but
|
||||
-- not Ada_Version_Explicit) when compiling predefined or internal units.
|
||||
@ -630,11 +631,16 @@ package Opt is
|
||||
-- Set to True to convert nonbinary modular additions into code
|
||||
-- that relies on the front-end expansion of operator Mod.
|
||||
|
||||
function Extensions_Allowed return Boolean is
|
||||
(Ada_Version = Ada_With_Extensions);
|
||||
function All_Extensions_Allowed return Boolean is
|
||||
(Ada_Version = Ada_With_All_Extensions);
|
||||
-- True if GNAT specific language extensions are allowed. See GNAT RM for
|
||||
-- details.
|
||||
|
||||
function Core_Extensions_Allowed return Boolean is
|
||||
(Ada_Version >= Ada_With_Core_Extensions);
|
||||
-- True if some but not all GNAT specific language extensions are allowed.
|
||||
-- See GNAT RM for details.
|
||||
|
||||
type External_Casing_Type is (
|
||||
As_Is, -- External names cased as they appear in the Ada source
|
||||
Uppercase, -- External names forced to all uppercase letters
|
||||
|
@ -2839,7 +2839,8 @@ package body Ch3 is
|
||||
else
|
||||
P_Index_Subtype_Def_With_Fixed_Lower_Bound (Subtype_Mark_Node);
|
||||
|
||||
Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr);
|
||||
Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr,
|
||||
Is_Core_Extension => True);
|
||||
end if;
|
||||
|
||||
exit when Token in Tok_Right_Paren | Tok_Of;
|
||||
@ -2909,7 +2910,8 @@ package body Ch3 is
|
||||
(Subtype_Mark_Node);
|
||||
|
||||
Error_Msg_GNAT_Extension
|
||||
("fixed-lower-bound array", Token_Ptr);
|
||||
("fixed-lower-bound array", Token_Ptr,
|
||||
Is_Core_Extension => True);
|
||||
end if;
|
||||
|
||||
exit when Token in Tok_Right_Paren | Tok_Of;
|
||||
@ -3412,7 +3414,8 @@ package body Ch3 is
|
||||
-- later during analysis), and scan to the next token.
|
||||
|
||||
if Token = Tok_Box then
|
||||
Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr);
|
||||
Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr,
|
||||
Is_Core_Extension => True);
|
||||
|
||||
Expr_Node := Empty;
|
||||
Scan;
|
||||
|
@ -1775,7 +1775,7 @@ package body Ch4 is
|
||||
if Token = Tok_Identifier then
|
||||
Id := P_Defining_Identifier;
|
||||
if Token = Tok_Greater then
|
||||
if Extensions_Allowed then
|
||||
if Core_Extensions_Allowed then
|
||||
Set_Box_Present (Assoc_Node);
|
||||
Set_Binding_Chars (Assoc_Node, Chars (Id));
|
||||
Box_Present := True;
|
||||
@ -1813,7 +1813,7 @@ package body Ch4 is
|
||||
if Token = Tok_Identifier then
|
||||
Id := P_Defining_Identifier;
|
||||
|
||||
if not Extensions_Allowed then
|
||||
if not Core_Extensions_Allowed then
|
||||
Error_Msg_GNAT_Extension
|
||||
("IS following component association", Token_Ptr);
|
||||
elsif Box_With_Identifier_Present then
|
||||
|
@ -73,10 +73,12 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
|
||||
-- Check the expression of the specified argument to make sure that it
|
||||
-- is a string literal. If not give error and raise Error_Resync.
|
||||
|
||||
procedure Check_Arg_Is_On_Or_Off (Arg : Node_Id);
|
||||
procedure Check_Arg_Is_On_Or_Off
|
||||
(Arg : Node_Id; All_OK_Too : Boolean := False);
|
||||
-- Check the expression of the specified argument to make sure that it
|
||||
-- is an identifier which is either ON or OFF, and if not, then issue
|
||||
-- an error message and raise Error_Resync.
|
||||
-- an error message and raise Error_Resync. If All_OK_Too is True,
|
||||
-- then an ALL identifer is also acceptable.
|
||||
|
||||
procedure Check_No_Identifier (Arg : Node_Id);
|
||||
-- Checks that the given argument does not have an identifier. If
|
||||
@ -167,17 +169,26 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
|
||||
-- Check_Arg_Is_On_Or_Off --
|
||||
----------------------------
|
||||
|
||||
procedure Check_Arg_Is_On_Or_Off (Arg : Node_Id) is
|
||||
procedure Check_Arg_Is_On_Or_Off
|
||||
(Arg : Node_Id; All_OK_Too : Boolean := False)
|
||||
is
|
||||
Argx : constant Node_Id := Expression (Arg);
|
||||
|
||||
Error : Boolean := Nkind (Expression (Arg)) /= N_Identifier;
|
||||
begin
|
||||
if Nkind (Expression (Arg)) /= N_Identifier
|
||||
or else Chars (Argx) not in Name_On | Name_Off
|
||||
then
|
||||
if not Error then
|
||||
Error := (Chars (Argx) not in Name_On | Name_Off)
|
||||
and then not (All_OK_Too and Chars (Argx) = Name_All);
|
||||
end if;
|
||||
if Error then
|
||||
Error_Msg_Name_2 := Name_On;
|
||||
Error_Msg_Name_3 := Name_Off;
|
||||
|
||||
Error_Msg_N ("argument for pragma% must be% or%", Argx);
|
||||
if All_OK_Too then
|
||||
Error_Msg_Name_4 := Name_All;
|
||||
Error_Msg_N ("argument for pragma% must be% or% or%", Argx);
|
||||
else
|
||||
Error_Msg_N ("argument for pragma% must be% or%", Argx);
|
||||
end if;
|
||||
raise Error_Resync;
|
||||
end if;
|
||||
end Check_Arg_Is_On_Or_Off;
|
||||
@ -414,7 +425,7 @@ begin
|
||||
-- Extensions_Allowed (GNAT) --
|
||||
-------------------------------
|
||||
|
||||
-- pragma Extensions_Allowed (Off | On)
|
||||
-- pragma Extensions_Allowed (Off | On | All)
|
||||
|
||||
-- The processing for pragma Extensions_Allowed must be done at
|
||||
-- parse time, since extensions mode may affect what is accepted.
|
||||
@ -422,10 +433,12 @@ begin
|
||||
when Pragma_Extensions_Allowed =>
|
||||
Check_Arg_Count (1);
|
||||
Check_No_Identifier (Arg1);
|
||||
Check_Arg_Is_On_Or_Off (Arg1);
|
||||
Check_Arg_Is_On_Or_Off (Arg1, All_OK_Too => True);
|
||||
|
||||
if Chars (Expression (Arg1)) = Name_On then
|
||||
Ada_Version := Ada_With_Extensions;
|
||||
Ada_Version := Ada_With_Core_Extensions;
|
||||
elsif Chars (Expression (Arg1)) = Name_All then
|
||||
Ada_Version := Ada_With_All_Extensions;
|
||||
else
|
||||
Ada_Version := Ada_Version_Explicit;
|
||||
end if;
|
||||
|
@ -3888,7 +3888,7 @@ package body Sem_Attr is
|
||||
|
||||
elsif (Is_Generic_Type (P_Type)
|
||||
or else Is_Generic_Actual_Type (P_Type))
|
||||
and then Extensions_Allowed
|
||||
and then All_Extensions_Allowed
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
@ -3581,7 +3581,7 @@ package body Sem_Case is
|
||||
|
||||
-- Hold on, maybe it isn't a complete mess after all.
|
||||
|
||||
if Extensions_Allowed and then Subtyp /= Any_Type then
|
||||
if Core_Extensions_Allowed and then Subtyp /= Any_Type then
|
||||
Check_Composite_Case_Selector;
|
||||
Check_Case_Pattern_Choices;
|
||||
end if;
|
||||
@ -3864,7 +3864,7 @@ package body Sem_Case is
|
||||
function Is_Case_Choice_Pattern (Expr : Node_Id) return Boolean is
|
||||
E : Node_Id := Expr;
|
||||
begin
|
||||
if not Extensions_Allowed then
|
||||
if not Core_Extensions_Allowed then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
|
@ -2399,9 +2399,9 @@ package body Sem_Ch13 is
|
||||
|
||||
if not Is_Expression_Function (E)
|
||||
and then
|
||||
not (Extensions_Allowed and then Is_Imported_Intrinsic)
|
||||
not (All_Extensions_Allowed and then Is_Imported_Intrinsic)
|
||||
then
|
||||
if Extensions_Allowed then
|
||||
if All_Extensions_Allowed then
|
||||
Error_Msg_N
|
||||
("aspect % requires intrinsic or expression function",
|
||||
Aspect);
|
||||
@ -4212,7 +4212,7 @@ package body Sem_Ch13 is
|
||||
goto Continue;
|
||||
|
||||
when Aspect_Designated_Storage_Model =>
|
||||
if not Extensions_Allowed then
|
||||
if not All_Extensions_Allowed then
|
||||
Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect));
|
||||
|
||||
elsif not Is_Type (E)
|
||||
@ -4227,7 +4227,7 @@ package body Sem_Ch13 is
|
||||
goto Continue;
|
||||
|
||||
when Aspect_Storage_Model_Type =>
|
||||
if not Extensions_Allowed then
|
||||
if not All_Extensions_Allowed then
|
||||
Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect));
|
||||
|
||||
elsif not Is_Type (E)
|
||||
|
@ -3519,7 +3519,7 @@ package body Sem_Ch3 is
|
||||
-- Initialize the list of primitive operations to an empty list,
|
||||
-- to cover tagged types as well as untagged types. For untagged
|
||||
-- types this is used either to analyze the call as legal when
|
||||
-- Extensions_Allowed is True, or to issue a better error message
|
||||
-- Core_Extensions_Allowed is True, or to issue a better error message
|
||||
-- otherwise.
|
||||
|
||||
Set_Direct_Primitive_Operations (T, New_Elmt_List);
|
||||
@ -5730,7 +5730,7 @@ package body Sem_Ch3 is
|
||||
-- operations to an empty list.
|
||||
|
||||
if Is_Tagged_Type (Id)
|
||||
or else Extensions_Allowed
|
||||
or else Core_Extensions_Allowed
|
||||
then
|
||||
Set_Direct_Primitive_Operations (Id, New_Elmt_List);
|
||||
end if;
|
||||
|
@ -5423,7 +5423,8 @@ package body Sem_Ch4 is
|
||||
-- untagged record types.
|
||||
|
||||
if Ada_Version >= Ada_2005
|
||||
and then (Is_Tagged_Type (Prefix_Type) or else Extensions_Allowed)
|
||||
and then (Is_Tagged_Type (Prefix_Type)
|
||||
or else Core_Extensions_Allowed)
|
||||
and then not Is_Concurrent_Type (Prefix_Type)
|
||||
then
|
||||
if Nkind (Parent (N)) = N_Generic_Association
|
||||
@ -5499,7 +5500,7 @@ package body Sem_Ch4 is
|
||||
-- Extension feature: Also support calls with prefixed views for
|
||||
-- untagged private types.
|
||||
|
||||
if Extensions_Allowed then
|
||||
if Core_Extensions_Allowed then
|
||||
if Try_Object_Operation (N) then
|
||||
return;
|
||||
end if;
|
||||
@ -5760,7 +5761,7 @@ package body Sem_Ch4 is
|
||||
-- Extension feature: Also support calls with prefixed views for
|
||||
-- untagged types.
|
||||
|
||||
elsif Extensions_Allowed
|
||||
elsif Core_Extensions_Allowed
|
||||
and then Try_Object_Operation (N)
|
||||
then
|
||||
return;
|
||||
@ -9862,7 +9863,7 @@ package body Sem_Ch4 is
|
||||
|
||||
if (not Is_Tagged_Type (Obj_Type)
|
||||
and then
|
||||
(not (Extensions_Allowed or Allow_Extensions)
|
||||
(not (Core_Extensions_Allowed or Allow_Extensions)
|
||||
or else not Present (Primitive_Operations (Obj_Type))))
|
||||
or else Is_Incomplete_Type (Obj_Type)
|
||||
then
|
||||
@ -9891,7 +9892,7 @@ package body Sem_Ch4 is
|
||||
-- have homographic prefixed-view operations that could result
|
||||
-- in an ambiguity, but handling properly may be tricky. ???)
|
||||
|
||||
if (Extensions_Allowed or Allow_Extensions)
|
||||
if (Core_Extensions_Allowed or Allow_Extensions)
|
||||
and then not Prim_Result
|
||||
and then Is_Named_Access_Type (Prev_Obj_Type)
|
||||
and then Present (Direct_Primitive_Operations (Prev_Obj_Type))
|
||||
|
@ -1614,7 +1614,7 @@ package body Sem_Ch5 is
|
||||
-- out non-discretes may resolve the ambiguity.
|
||||
-- But GNAT extensions allow casing on non-discretes.
|
||||
|
||||
elsif Extensions_Allowed and then Is_Overloaded (Exp) then
|
||||
elsif Core_Extensions_Allowed and then Is_Overloaded (Exp) then
|
||||
|
||||
-- It would be nice if we could generate all the right error
|
||||
-- messages by calling "Resolve (Exp, Any_Type);" in the
|
||||
@ -1632,7 +1632,7 @@ package body Sem_Ch5 is
|
||||
-- Check for a GNAT-extension "general" case statement (i.e., one where
|
||||
-- the type of the selecting expression is not discrete).
|
||||
|
||||
elsif Extensions_Allowed
|
||||
elsif Core_Extensions_Allowed
|
||||
and then not Is_Discrete_Type (Etype (Exp))
|
||||
then
|
||||
Resolve (Exp, Etype (Exp));
|
||||
@ -1670,7 +1670,7 @@ package body Sem_Ch5 is
|
||||
("(Ada 83) case expression cannot be of a generic type", Exp);
|
||||
return;
|
||||
|
||||
elsif not Extensions_Allowed
|
||||
elsif not Core_Extensions_Allowed
|
||||
and then not Is_Discrete_Type (Exp_Type)
|
||||
then
|
||||
Error_Msg_N
|
||||
|
@ -7918,7 +7918,7 @@ package body Sem_Ch8 is
|
||||
|
||||
if Is_Type (P_Type)
|
||||
and then (Has_Components (P_Type)
|
||||
or else (Extensions_Allowed
|
||||
or else (Core_Extensions_Allowed
|
||||
and then not Is_Concurrent_Type (P_Type)))
|
||||
and then not Is_Overloadable (P_Name)
|
||||
and then not Is_Type (P_Name)
|
||||
@ -8173,7 +8173,7 @@ package body Sem_Ch8 is
|
||||
("prefixed call is only allowed for objects of a "
|
||||
& "tagged type unless -gnatX is used", N);
|
||||
|
||||
if not Extensions_Allowed
|
||||
if not Core_Extensions_Allowed
|
||||
and then
|
||||
Try_Object_Operation (N, Allow_Extensions => True)
|
||||
then
|
||||
|
@ -2859,7 +2859,7 @@ package body Sem_Eval is
|
||||
-- Intrinsic calls as part of a static function is a language extension.
|
||||
|
||||
if Checking_Potentially_Static_Expression
|
||||
and then not Extensions_Allowed
|
||||
and then not All_Extensions_Allowed
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
@ -16595,16 +16595,18 @@ package body Sem_Prag is
|
||||
-- Extensions_Allowed --
|
||||
------------------------
|
||||
|
||||
-- pragma Extensions_Allowed (ON | OFF);
|
||||
-- pragma Extensions_Allowed (ON | OFF | ALL);
|
||||
|
||||
when Pragma_Extensions_Allowed =>
|
||||
GNAT_Pragma;
|
||||
Check_Arg_Count (1);
|
||||
Check_No_Identifiers;
|
||||
Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
|
||||
Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off, Name_All);
|
||||
|
||||
if Chars (Get_Pragma_Arg (Arg1)) = Name_On then
|
||||
Ada_Version := Ada_With_Extensions;
|
||||
Ada_Version := Ada_With_Core_Extensions;
|
||||
elsif Chars (Get_Pragma_Arg (Arg1)) = Name_All then
|
||||
Ada_Version := Ada_With_All_Extensions;
|
||||
else
|
||||
Ada_Version := Ada_Version_Explicit;
|
||||
Ada_Version_Pragma := Empty;
|
||||
|
@ -3195,7 +3195,7 @@ package body Sem_Util is
|
||||
Actual : Node_Id;
|
||||
|
||||
begin
|
||||
if Extensions_Allowed then
|
||||
if All_Extensions_Allowed then
|
||||
Actual := First_Actual (Call);
|
||||
while Present (Actual) loop
|
||||
if Nkind (Actual) = N_Aggregate then
|
||||
|
@ -1391,12 +1391,21 @@ package body Switch.C is
|
||||
Ptr := Ptr + 1;
|
||||
Xref_Active := False;
|
||||
|
||||
-- -gnatX (language extensions)
|
||||
-- -gnatX (core language extensions)
|
||||
|
||||
when 'X' =>
|
||||
Ptr := Ptr + 1;
|
||||
Ada_Version := Ada_With_Extensions;
|
||||
Ada_Version_Explicit := Ada_With_Extensions;
|
||||
|
||||
if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
|
||||
-- -gnatX0 (all language extensions)
|
||||
|
||||
Ptr := Ptr + 1;
|
||||
Ada_Version := Ada_With_All_Extensions;
|
||||
else
|
||||
Ada_Version := Ada_With_Core_Extensions;
|
||||
end if;
|
||||
|
||||
Ada_Version_Explicit := Ada_Version;
|
||||
Ada_Version_Pragma := Empty;
|
||||
|
||||
-- -gnaty (style checks)
|
||||
|
Loading…
x
Reference in New Issue
Block a user