Commit bbf1aec2 by Robert Dewar Committed by Arnaud Charlet

par_sco.adb, [...]: Minor reformatting.

2013-07-05  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, sem_ch12.adb, par-ch5.adb: Minor reformatting.
	* gnat_rm.texi: Document pragma Profile_Warnings.
	* restrict.ads, sem_prag.adb: Minor reformatting.

From-SVN: r200695
parent fd3fa68f
2013-07-05 Robert Dewar <dewar@adacore.com>
* par_sco.adb, sem_ch12.adb, par-ch5.adb: Minor reformatting.
* gnat_rm.texi: Document pragma Profile_Warnings.
* restrict.ads, sem_prag.adb: Minor reformatting.
2013-07-05 Ed Schonberg <schonberg@adacore.com> 2013-07-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Check_Formal_Package_Instance): Handle properly * sem_ch12.adb (Check_Formal_Package_Instance): Handle properly
......
...@@ -203,9 +203,8 @@ Implementation Defined Pragmas ...@@ -203,9 +203,8 @@ Implementation Defined Pragmas
* Pragma Precondition:: * Pragma Precondition::
* Pragma Preelaborable_Initialization:: * Pragma Preelaborable_Initialization::
* Pragma Priority_Specific_Dispatching:: * Pragma Priority_Specific_Dispatching::
* Pragma Profile (Ravenscar):: * Pragma Profile::
* Pragma Profile (Restricted):: * Pragma Profile_Warnings::
* Pragma Profile (Rational)::
* Pragma Psect_Object:: * Pragma Psect_Object::
* Pragma Pure_Function:: * Pragma Pure_Function::
* Pragma Relative_Deadline:: * Pragma Relative_Deadline::
...@@ -1001,9 +1000,8 @@ consideration, the use of these pragmas should be minimized. ...@@ -1001,9 +1000,8 @@ consideration, the use of these pragmas should be minimized.
* Pragma Precondition:: * Pragma Precondition::
* Pragma Preelaborable_Initialization:: * Pragma Preelaborable_Initialization::
* Pragma Priority_Specific_Dispatching:: * Pragma Priority_Specific_Dispatching::
* Pragma Profile (Ravenscar):: * Pragma Profile::
* Pragma Profile (Restricted):: * Pragma Profile_Warnings::
* Pragma Profile (Rational)::
* Pragma Psect_Object:: * Pragma Psect_Object::
* Pragma Pure_Function:: * Pragma Pure_Function::
* Pragma Relative_Deadline:: * Pragma Relative_Deadline::
...@@ -5074,21 +5072,35 @@ inlining (-gnatN option set) are accepted and legality-checked ...@@ -5074,21 +5072,35 @@ inlining (-gnatN option set) are accepted and legality-checked
by the compiler, but are ignored at run-time even if postcondition by the compiler, but are ignored at run-time even if postcondition
checking is enabled. checking is enabled.
@node Pragma Profile (Ravenscar) @node Pragma Profile
@unnumberedsec Pragma Profile (Ravenscar) @unnumberedsec Pragma Profile
@findex Ravenscar @findex Profile
@noindent @noindent
Syntax: Syntax:
@smallexample @c ada @smallexample @c ada
pragma Profile (Ravenscar | Restricted); pragma Profile (Ravenscar | Restricted | Rational);
@end smallexample @end smallexample
@noindent @noindent
This pragma is standard in Ada 2005, but is available in all earlier This pragma is standard in Ada 2005, but is available in all earlier
versions of Ada as an implementation-defined pragma. This is a versions of Ada as an implementation-defined pragma. This is a
configuration pragma that establishes the following set of configuration configuration pragma that establishes a set of configiuration pragmas
pragmas: that depend on the argument. @code{Ravenscar} is standard in Ada 2005.
The other two possibilities (@code{Restricted} or @code{Rational})
are implementation-defined. The set of configuration pragmas
is defined in the following sections.
@itemize
@item Pragma Profile (Ravenscar)
@findex Ravenscar
@noindent
The @code{Ravenscar} profile is standard in Ada 2005,
but is available in all earlier
versions of Ada as an implementation-defined pragma. This profile
establishes the following set of configuration pragmas:
@table @code @table @code
@item Task_Dispatching_Policy (FIFO_Within_Priorities) @item Task_Dispatching_Policy (FIFO_Within_Priorities)
...@@ -5172,20 +5184,11 @@ that pragma @code{Profile (Ravenscar)}, like the pragma ...@@ -5172,20 +5184,11 @@ that pragma @code{Profile (Ravenscar)}, like the pragma
automatically causes the use of a simplified, automatically causes the use of a simplified,
more efficient version of the tasking run-time system. more efficient version of the tasking run-time system.
@node Pragma Profile (Restricted) @item Pragma Profile (Restricted)
@unnumberedsec Pragma Profile (Restricted)
@findex Restricted Run Time @findex Restricted Run Time
@noindent @noindent
Syntax: This profile corresponds to the GNAT restricted run time. It
establishes the following set of restrictions:
@smallexample @c ada
pragma Profile (Restricted);
@end smallexample
@noindent
This is an implementation-defined version of the standard pragma defined
in Ada 2005. It is available in all versions of Ada. It is a
configuration pragma that establishes the following set of restrictions:
@itemize @bullet @itemize @bullet
@item No_Abort_Statements @item No_Abort_Statements
...@@ -5210,28 +5213,39 @@ This set of restrictions causes the automatic selection of a simplified ...@@ -5210,28 +5213,39 @@ This set of restrictions causes the automatic selection of a simplified
version of the run time that provides improved performance for the version of the run time that provides improved performance for the
limited set of tasking functionality permitted by this set of restrictions. limited set of tasking functionality permitted by this set of restrictions.
@node Pragma Profile (Rational) @item Pragma Profile (Rational)
@unnumberedsec Pragma Profile (Rational)
@findex Rational compatibility mode @findex Rational compatibility mode
@noindent @noindent
Syntax:
@smallexample @c ada
pragma Profile (Rational);
@end smallexample
@noindent
The Rational profile is intended to facilitate porting legacy code that The Rational profile is intended to facilitate porting legacy code that
compiles with the Rational APEX compiler, even when the code includes non- compiles with the Rational APEX compiler, even when the code includes non-
conforming Ada constructs. The profile enables the following three pragmas: conforming Ada constructs. The profile enables the following three pragmas:
@itemize @bullet @itemize @bullet
@item pragma Implicit_Packing @item pragma Implicit_Packing
@item pragma Overriding_Renamings @item pragma Overriding_Renamings
@item pragma Use_VADS_Size @item pragma Use_VADS_Size
@end itemize @end itemize
@end itemize
@node Pragma Profile_Warnings
@unnumberedsec Pragma Profile_Warnings
@findex Profile_Warnings
@noindent
Syntax:
@smallexample @c ada
pragma Profile_Warnings (Ravenscar | Restricted | Rational);
@end smallexample
@noindent
This is an implementation-defined pragma that is similar in
effect to @code{pragma Profile} except that instead of
generating @code{Restrictions} pragmas, it generates
@code{Restriction_Warnings} pragmas. The result is that
violations of the profile generate warning messages instead
of error messages.
@noindent @noindent
@node Pragma Psect_Object @node Pragma Psect_Object
@unnumberedsec Pragma Psect_Object @unnumberedsec Pragma Psect_Object
...@@ -20436,3 +20450,4 @@ this kind of implementation dependent addition. ...@@ -20436,3 +20450,4 @@ this kind of implementation dependent addition.
@contents @contents
@bye @bye
tablishes the following set of restrictions:
...@@ -595,7 +595,8 @@ package body Ch5 is ...@@ -595,7 +595,8 @@ package body Ch5 is
-- For statement (labeled loop statement with FOR) -- For statement (labeled loop statement with FOR)
elsif Token = Tok_For then elsif Token = Tok_For then
Append_To (Statement_List, P_For_Statement (Id_Node)); Append_To (Statement_List,
P_For_Statement (Id_Node));
-- Improper statement follows label. If we have an -- Improper statement follows label. If we have an
-- expression token, then assume the colon was part -- expression token, then assume the colon was part
......
...@@ -2102,6 +2102,7 @@ package body Par_SCO is ...@@ -2102,6 +2102,7 @@ package body Par_SCO is
if Nkind (N) /= N_Implicit_Label_Declaration then if Nkind (N) /= N_Implicit_Label_Declaration then
Traverse_One (N); Traverse_One (N);
end if; end if;
Next (N); Next (N);
end loop; end loop;
......
...@@ -101,9 +101,9 @@ package Restrict is ...@@ -101,9 +101,9 @@ package Restrict is
(No_Unchecked_Deallocation, "a-uncdea"), (No_Unchecked_Deallocation, "a-uncdea"),
(No_Unchecked_Deallocation, "unchdeal")); (No_Unchecked_Deallocation, "unchdeal"));
-- The following map has True for all GNAT pragmas. It is used to -- The following map has True for all GNAT-defined Restrictions. It is used
-- implement pragma Restrictions (No_Implementation_Restrictions) -- to implement pragma Restrictions (No_Implementation_Restrictions) (which
-- (which is why this restriction itself is excluded from the list). -- is why this restriction itself is excluded from the list).
Implementation_Restriction : array (All_Restrictions) of Boolean := Implementation_Restriction : array (All_Restrictions) of Boolean :=
(Simple_Barriers => True, (Simple_Barriers => True,
......
...@@ -5226,8 +5226,8 @@ package body Sem_Ch12 is ...@@ -5226,8 +5226,8 @@ package body Sem_Ch12 is
-- Ditto for defaulted formal subprograms. -- Ditto for defaulted formal subprograms.
elsif Is_Overloadable (E1) elsif Is_Overloadable (E1)
and then Nkind (Unit_Declaration_Node (E2)) and then Nkind (Unit_Declaration_Node (E2)) in
in N_Formal_Subprogram_Declaration N_Formal_Subprogram_Declaration
then then
goto Next_E; goto Next_E;
......
...@@ -3746,7 +3746,6 @@ package body Sem_Prag is ...@@ -3746,7 +3746,6 @@ package body Sem_Prag is
begin begin
-- First check pragma arguments -- First check pragma arguments
GNAT_Pragma;
Check_At_Least_N_Arguments (2); Check_At_Least_N_Arguments (2);
Check_At_Most_N_Arguments (4); Check_At_Most_N_Arguments (4);
Check_Arg_Order Check_Arg_Order
...@@ -5295,7 +5294,6 @@ package body Sem_Prag is ...@@ -5295,7 +5294,6 @@ package body Sem_Prag is
procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id) is procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id) is
begin begin
GNAT_Pragma;
Check_No_Identifiers; Check_No_Identifiers;
Check_At_Most_N_Arguments (1); Check_At_Most_N_Arguments (1);
...@@ -9656,8 +9654,8 @@ package body Sem_Prag is ...@@ -9656,8 +9654,8 @@ package body Sem_Prag is
-- pragma Check_Name (check_IDENTIFIER); -- pragma Check_Name (check_IDENTIFIER);
when Pragma_Check_Name => when Pragma_Check_Name =>
Check_No_Identifiers;
GNAT_Pragma; GNAT_Pragma;
Check_No_Identifiers;
Check_Valid_Configuration_Pragma; Check_Valid_Configuration_Pragma;
Check_Arg_Count (1); Check_Arg_Count (1);
Check_Arg_Is_Identifier (Arg1); Check_Arg_Is_Identifier (Arg1);
...@@ -10667,6 +10665,7 @@ package body Sem_Prag is ...@@ -10667,6 +10665,7 @@ package body Sem_Prag is
-- pragma Disable_Atomic_Synchronization [(Entity)]; -- pragma Disable_Atomic_Synchronization [(Entity)];
when Pragma_Disable_Atomic_Synchronization => when Pragma_Disable_Atomic_Synchronization =>
GNAT_Pragma;
Process_Disable_Enable_Atomic_Sync (Name_Suppress); Process_Disable_Enable_Atomic_Sync (Name_Suppress);
------------------- -------------------
...@@ -11098,6 +11097,7 @@ package body Sem_Prag is ...@@ -11098,6 +11097,7 @@ package body Sem_Prag is
-- pragma Enable_Atomic_Synchronization [(Entity)]; -- pragma Enable_Atomic_Synchronization [(Entity)];
when Pragma_Enable_Atomic_Synchronization => when Pragma_Enable_Atomic_Synchronization =>
GNAT_Pragma;
Process_Disable_Enable_Atomic_Sync (Name_Unsuppress); Process_Disable_Enable_Atomic_Sync (Name_Unsuppress);
------------ ------------
...@@ -11598,6 +11598,18 @@ package body Sem_Prag is ...@@ -11598,6 +11598,18 @@ package body Sem_Prag is
end case; end case;
end External_Name_Casing; end External_Name_Casing;
---------------
-- Fast_Math --
---------------
-- pragma Fast_Math;
when Pragma_Fast_Math =>
GNAT_Pragma;
Check_No_Identifiers;
Check_Valid_Configuration_Pragma;
Fast_Math := True;
-------------------------- --------------------------
-- Favor_Top_Level -- -- Favor_Top_Level --
-------------------------- --------------------------
...@@ -11629,18 +11641,6 @@ package body Sem_Prag is ...@@ -11629,18 +11641,6 @@ package body Sem_Prag is
end if; end if;
end Favor_Top_Level; end Favor_Top_Level;
---------------
-- Fast_Math --
---------------
-- pragma Fast_Math;
when Pragma_Fast_Math =>
GNAT_Pragma;
Check_No_Identifiers;
Check_Valid_Configuration_Pragma;
Fast_Math := True;
--------------------------- ---------------------------
-- Finalize_Storage_Only -- -- Finalize_Storage_Only --
--------------------------- ---------------------------
...@@ -11965,6 +11965,7 @@ package body Sem_Prag is ...@@ -11965,6 +11965,7 @@ package body Sem_Prag is
Ent : Entity_Id; Ent : Entity_Id;
begin begin
GNAT_Pragma;
Check_No_Identifiers; Check_No_Identifiers;
-- Form with no arguments -- Form with no arguments
...@@ -14477,6 +14478,41 @@ package body Sem_Prag is ...@@ -14477,6 +14478,41 @@ package body Sem_Prag is
Optimize_Alignment_Local := True; Optimize_Alignment_Local := True;
end Optimize_Alignment; end Optimize_Alignment;
-------------
-- Ordered --
-------------
-- pragma Ordered (first_enumeration_subtype_LOCAL_NAME);
when Pragma_Ordered => Ordered : declare
Assoc : constant Node_Id := Arg1;
Type_Id : Node_Id;
Typ : Entity_Id;
begin
GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
Type_Id := Get_Pragma_Arg (Assoc);
Find_Type (Type_Id);
Typ := Entity (Type_Id);
if Typ = Any_Type then
return;
else
Typ := Underlying_Type (Typ);
end if;
if not Is_Enumeration_Type (Typ) then
Error_Pragma ("pragma% must specify enumeration type");
end if;
Check_First_Subtype (Arg1);
Set_Has_Pragma_Ordered (Base_Type (Typ));
end Ordered;
------------------- -------------------
-- Overflow_Mode -- -- Overflow_Mode --
------------------- -------------------
...@@ -14557,43 +14593,16 @@ package body Sem_Prag is ...@@ -14557,43 +14593,16 @@ package body Sem_Prag is
end if; end if;
end Overflow_Mode; end Overflow_Mode;
when Pragma_Overriding_Renamings => --------------------------
Overriding_Renamings := True; -- Overriding Renamings --
--------------------------
-------------
-- Ordered --
-------------
-- pragma Ordered (first_enumeration_subtype_LOCAL_NAME);
when Pragma_Ordered => Ordered : declare -- pragma Overriding_Renamings;
Assoc : constant Node_Id := Arg1;
Type_Id : Node_Id;
Typ : Entity_Id;
begin when Pragma_Overriding_Renamings =>
GNAT_Pragma; GNAT_Pragma;
Check_No_Identifiers; Check_Arg_Count (0);
Check_Arg_Count (1); Overriding_Renamings := True;
Check_Arg_Is_Local_Name (Arg1);
Type_Id := Get_Pragma_Arg (Assoc);
Find_Type (Type_Id);
Typ := Entity (Type_Id);
if Typ = Any_Type then
return;
else
Typ := Underlying_Type (Typ);
end if;
if not Is_Enumeration_Type (Typ) then
Error_Pragma ("pragma% must specify enumeration type");
end if;
Check_First_Subtype (Arg1);
Set_Has_Pragma_Ordered (Base_Type (Typ));
end Ordered;
---------- ----------
-- Pack -- -- Pack --
...@@ -15458,6 +15467,8 @@ package body Sem_Prag is ...@@ -15458,6 +15467,8 @@ package body Sem_Prag is
GNAT_Pragma; GNAT_Pragma;
Check_Arg_Count (0); Check_Arg_Count (0);
-- This code does not agree with above (no effect) comment ???
if In_Extended_Main_Source_Unit (N) then if In_Extended_Main_Source_Unit (N) then
Propagate_Exceptions := True; Propagate_Exceptions := True;
end if; end if;
...@@ -16896,6 +16907,7 @@ package body Sem_Prag is ...@@ -16896,6 +16907,7 @@ package body Sem_Prag is
-- MODE_TYPE ::= Nominal | Robustness -- MODE_TYPE ::= Nominal | Robustness
when Pragma_Test_Case => when Pragma_Test_Case =>
GNAT_Pragma;
Check_Test_Case; Check_Test_Case;
-------------------------- --------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment