mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 17:00:58 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-01-04  Robert Dewar  <dewar@adacore.com>

	* table.adb: Minor reformatting.

2013-01-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Check_Redundant_Withs): A with_clause that does
	not come from source does not generate a warning for redundant
	with_clauses.

2013-01-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb, aspects.ads: Add Aspect_Global to all relevant tables.
	* par-prag.adb: Add pragma Global to the list of pragmas that
	do not need special processing by the parser.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Convert aspect
	Global into a pragma without any form of legality checks. The
	work is done by Analyze_Pragma. The aspect and pragma are both
	marked as needing delayed processing.  Insert the corresponding
	pragma of aspect Abstract_State in the visible declarations of the
	related package.
	(Check_Aspect_At_Freeze_Point): Aspect Global
	does not need processing even though it is marked as delayed.
	Alphabetize the list on aspect names.
	* sem_prag.adb: Add a value for pragma Global in table Sig_Flags.
	(Analyze_Pragma): Add ??? comment about the grammar of pragma
	Abstract_State.  Move the error location from the pragma to the
	state to improve the quality of error placement.  Add legality
	checks for pragma Global.
	* snames.ads-tmpl Add the following specially recognized names

2013-01-04  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch3.adb: Fix minor typo.

2013-01-04  Ed Schonberg  <schonberg@adacore.com>

	* par-ch13.adb (Aspect_Specifications_Present): In Strict mode,
	accept an aspect name followed by a comma, indicating a defaulted
	boolean aspect.

From-SVN: r194890
This commit is contained in:
Arnaud Charlet 2013-01-04 10:18:25 +01:00
parent 2a328c94e1
commit 7a1f177500
11 changed files with 480 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
2013-01-04 Robert Dewar <dewar@adacore.com>
* table.adb: Minor reformatting.
2013-01-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Check_Redundant_Withs): A with_clause that does
not come from source does not generate a warning for redundant
with_clauses.
2013-01-04 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb, aspects.ads: Add Aspect_Global to all relevant tables.
* par-prag.adb: Add pragma Global to the list of pragmas that
do not need special processing by the parser.
* sem_ch13.adb (Analyze_Aspect_Specifications): Convert aspect
Global into a pragma without any form of legality checks. The
work is done by Analyze_Pragma. The aspect and pragma are both
marked as needing delayed processing. Insert the corresponding
pragma of aspect Abstract_State in the visible declarations of the
related package.
(Check_Aspect_At_Freeze_Point): Aspect Global
does not need processing even though it is marked as delayed.
Alphabetize the list on aspect names.
* sem_prag.adb: Add a value for pragma Global in table Sig_Flags.
(Analyze_Pragma): Add ??? comment about the grammar of pragma
Abstract_State. Move the error location from the pragma to the
state to improve the quality of error placement. Add legality
checks for pragma Global.
* snames.ads-tmpl Add the following specially recognized names
2013-01-04 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch3.adb: Fix minor typo.
2013-01-04 Ed Schonberg <schonberg@adacore.com>
* par-ch13.adb (Aspect_Specifications_Present): In Strict mode,
accept an aspect name followed by a comma, indicating a defaulted
boolean aspect.
2013-01-04 Joel Brobecker <brobecker@adacore.com brobecker>
* gnat_ugn.texi: Document procedure to codesign GDB on Darwin.

1
gcc/ada/aspects.adb
View File

@ -269,6 +269,7 @@ package body Aspects is
Aspect_External_Name => Aspect_External_Name,
Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
Aspect_Global => Aspect_Global,
Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
Aspect_Import => Aspect_Import,
Aspect_Independent => Aspect_Independent,

4
gcc/ada/aspects.ads
View File

@ -94,6 +94,7 @@ package Aspects is
Aspect_Dynamic_Predicate,
Aspect_External_Name,
Aspect_External_Tag,
Aspect_Global, -- GNAT
Aspect_Implicit_Dereference,
Aspect_Input,
Aspect_Interrupt_Priority,
@ -231,6 +232,7 @@ package Aspects is
Aspect_Dimension => True,
Aspect_Dimension_System => True,
Aspect_Favor_Top_Level => True,
Aspect_Global => True,
Aspect_Inline_Always => True,
Aspect_Lock_Free => True,
Aspect_Object_Size => True,
@ -327,6 +329,7 @@ package Aspects is
Aspect_Dynamic_Predicate => Expression,
Aspect_External_Name => Expression,
Aspect_External_Tag => Expression,
Aspect_Global => Expression,
Aspect_Implicit_Dereference => Name,
Aspect_Input => Name,
Aspect_Interrupt_Priority => Expression,
@ -404,6 +407,7 @@ package Aspects is
Aspect_External_Tag => Name_External_Tag,
Aspect_Export => Name_Export,
Aspect_Favor_Top_Level => Name_Favor_Top_Level,
Aspect_Global => Name_Global,
Aspect_Implicit_Dereference => Name_Implicit_Dereference,
Aspect_Import => Name_Import,
Aspect_Independent => Name_Independent,

7
gcc/ada/par-ch13.adb
View File

@ -105,6 +105,13 @@ package body Ch13 is
if Token = Tok_Arrow then
Result := True;
-- The identifier may be the name of a boolean aspect with a
-- defaulted True value. Further checks when analyzing aspect
-- specification.
elsif Token = Tok_Comma then
Result := True;
elsif Token = Tok_Apostrophe then
Scan; -- past apostrophe

1
gcc/ada/par-prag.adb
View File

@ -1156,6 +1156,7 @@ begin
Pragma_Fast_Math |
Pragma_Finalize_Storage_Only |
Pragma_Float_Representation |
Pragma_Global |
Pragma_Ident |
Pragma_Implementation_Defined |
Pragma_Implemented |

7
gcc/ada/sem_ch10.adb
View File

@ -481,8 +481,15 @@ package body Sem_Ch10 is
-- In this case, the second with clause is redundant since
-- the pragma applies only to the first "with Pack;".
-- Note that we only consider with_clauses that comes from
-- source. In the case of renamings used as prefixes of names
-- in with_clauses, we generate a with_clause for the prefix,
-- which we do not treat as implicit because it is needed for
-- visibility analysis, but is also not redundant.
elsif Nkind (Cont_Item) = N_With_Clause
and then not Implicit_With (Cont_Item)
and then Comes_From_Source (Cont_Item)
and then not Limited_Present (Cont_Item)
and then Cont_Item /= Clause
and then Entity (Name (Cont_Item)) = Nam_Ent

65
gcc/ada/sem_ch13.adb
View File

@ -1436,7 +1436,7 @@ package body Sem_Ch13 is
-- Case 2d : Aspects that correspond to a pragma with one
-- argument.
when Aspect_Abstract_State =>
when Aspect_Abstract_State =>
Aitem :=
Make_Pragma (Loc,
Pragma_Identifier =>
@ -1447,7 +1447,20 @@ package body Sem_Ch13 is
Delay_Required := False;
when Aspect_Relative_Deadline =>
-- Aspect Global must be delayed because it can mention names
-- and benefit from the forward visibility rules applicable to
-- aspects of subprograms.
when Aspect_Global =>
Aitem :=
Make_Pragma (Loc,
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Name_Global),
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))));
when Aspect_Relative_Deadline =>
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
@ -1950,6 +1963,20 @@ package body Sem_Ch13 is
Prepend (Aitem, Declarations (N));
-- Aspect Abstract_State produces implicit declarations for
-- all state abstraction entities it defines. To emulate
-- this behavior, insert the pragma at the start of the
-- visible declarations of the related package.
elsif Nam = Name_Abstract_State
and then Nkind (N) = N_Package_Declaration
then
if No (Visible_Declarations (Specification (N))) then
Set_Visible_Declarations (Specification (N), New_List);
end if;
Prepend (Aitem, Visible_Declarations (Specification (N)));
else
if No (Pragmas_After (Aux)) then
Set_Pragmas_After (Aux, New_List);
@ -6887,32 +6914,32 @@ package body Sem_Ch13 is
Library_Unit_Aspects =>
T := Standard_Boolean;
-- Aspects corresponding to attribute definition clauses
when Aspect_Address =>
T := RTE (RE_Address);
when Aspect_Attach_Handler =>
T := RTE (RE_Interrupt_ID);
when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
T := RTE (RE_Bit_Order);
when Aspect_Convention =>
return;
-- Default_Value is resolved with the type entity in question
when Aspect_Default_Value =>
T := Entity (ASN);
when Aspect_CPU =>
T := RTE (RE_CPU_Range);
-- Default_Component_Value is resolved with the component type
when Aspect_Default_Component_Value =>
T := Component_Type (Entity (ASN));
-- Aspects corresponding to attribute definition clauses
-- Default_Value is resolved with the type entity in question
when Aspect_Address =>
T := RTE (RE_Address);
when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
T := RTE (RE_Bit_Order);
when Aspect_CPU =>
T := RTE (RE_CPU_Range);
when Aspect_Default_Value =>
T := Entity (ASN);
when Aspect_Dispatching_Domain =>
T := RTE (RE_Dispatching_Domain);
@ -6923,6 +6950,14 @@ package body Sem_Ch13 is
when Aspect_External_Name =>
T := Standard_String;
-- Global is a delayed aspect because it may reference names that
-- have not been declared yet. There is no action to be taken with
-- respect to the aspect itself as the reference checking is done on
-- the corresponding pragma.
when Aspect_Global =>
return;
when Aspect_Link_Name =>
T := Standard_String;

2
gcc/ada/sem_ch3.adb
View File

@ -10362,7 +10362,7 @@ package body Sem_Ch3 is
Set_Cloned_Subtype (Full, Full_Base);
end if;
-- It is unsafe to share to bounds of a scalar type, because the Itype
-- It is unsafe to share the bounds of a scalar type, because the Itype
-- is elaborated on demand, and if a bound is non-static then different
-- orders of elaboration in different units will lead to different
-- external symbols.

363
gcc/ada/sem_prag.adb
View File

@ -789,6 +789,8 @@ package body Sem_Prag is
procedure S14_Pragma;
-- Called for all pragmas defined for formal verification to check that
-- the S14_Extensions flag is set.
-- This name needs fixing ??? There is no such thing as an
-- "S14_Extensions" flag ???
function Is_Before_First_Decl
(Pragma_Node : Node_Id;
@ -6644,6 +6646,8 @@ package body Sem_Prag is
-- Abstract_State --
--------------------
-- ??? no formal grammar available yet
when Pragma_Abstract_State => Abstract_State : declare
Pack_Id : Entity_Id;
@ -6824,7 +6828,7 @@ package body Sem_Prag is
-- Any other attempt to declare a state is erroneous
else
Error_Msg_N ("malformed abstract state declaration", N);
Error_Msg_N ("malformed abstract state declaration", State);
end if;
-- Do not generate a state abstraction entity if it was not
@ -9946,6 +9950,362 @@ package body Sem_Prag is
end if;
end Float_Representation;
------------
-- Global --
------------
-- ??? no formal grammar pragma available yet
when Pragma_Global => Global : declare
Subp_Id : Entity_Id;
Seen : Elist_Id := No_Elist;
-- A list containing the entities of all the items processed so
-- far. It plays a role in detecting distinct entities.
-- Flags used to verify the consistency of modes
Contract_Seen : Boolean := False;
In_Out_Seen : Boolean := False;
Input_Seen : Boolean := False;
Output_Seen : Boolean := False;
procedure Analyze_Global_List
(List : Node_Id;
Global_Mode : Name_Id := Name_Input);
-- Verify the legality of a single global list declaration.
-- Global_Mode denotes the current mode in effect.
-------------------------
-- Analyze_Global_List --
-------------------------
procedure Analyze_Global_List
(List : Node_Id;
Global_Mode : Name_Id := Name_Input)
is
procedure Analyze_Global_Item
(Item : Node_Id;
Global_Mode : Name_Id);
-- Verify the legality of a single global item declaration.
-- Global_Mode denotes the current mode in effect.
procedure Check_Duplicate_Mode
(Mode : Node_Id;
Status : in out Boolean);
-- Flag Status denotes whether a particular mode has been seen
-- while processing a global list. This routine verifies that
-- Mode is not a duplicate mode and sets the flag Status.
procedure Check_Mode_Restriction_In_Function (Mode : Node_Id);
-- Mode denotes either In_Out or Output. Depending on the kind
-- of the related subprogram, emit an error if those two modes
-- apply to a function.
-------------------------
-- Analyze_Global_Item --
-------------------------
procedure Analyze_Global_Item
(Item : Node_Id;
Global_Mode : Name_Id)
is
function Is_Duplicate_Item (Id : Entity_Id) return Boolean;
-- Determine whether Id has already been processed
-----------------------
-- Is_Duplicate_Item --
-----------------------
function Is_Duplicate_Item (Id : Entity_Id) return Boolean is
Item_Elmt : Elmt_Id;
begin
if Present (Seen) then
Item_Elmt := First_Elmt (Seen);
while Present (Item_Elmt) loop
if Node (Item_Elmt) = Id then
return True;
end if;
Next_Elmt (Item_Elmt);
end loop;
end if;
return False;
end Is_Duplicate_Item;
-- Local declarations
Id : Entity_Id;
-- Start of processing for Analyze_Global_Item
begin
-- Detect one of the following cases
-- with Global => (null, Name)
-- with Global => (Name_1, null, Name_2)
-- with Global => (Name, null)
if Nkind (Item) = N_Null then
Error_Msg_N
("cannot mix null and non-null global items", Item);
return;
end if;
-- Ensure that the formal parameters are visible when
-- processing an item. This falls out of the general rule
-- of aspects pertaining to subprogram declarations.
Push_Scope (Subp_Id);
Install_Formals (Subp_Id);
Analyze (Item);
Pop_Scope;
if Is_Entity_Name (Item) then
Id := Entity (Item);
-- A global item cannot reference a formal parameter. Do
-- this check first to provide a better error diagnostic.
if Is_Formal (Id) then
Error_Msg_N
("global item cannot reference formal parameter",
Item);
return;
-- The only legal references are those to abstract states
-- and variables.
elsif not Ekind_In (Entity (Item), E_Abstract_State,
E_Variable)
then
Error_Msg_N
("global item must denote variable or state", Item);
return;
end if;
-- Some form of illegal construct masquerading as a name
else
Error_Msg_N
("global item must denote variable or state", Item);
return;
end if;
-- The same entity might be referenced through various way.
-- Check the entity of the item rather than the item itself.
if Is_Duplicate_Item (Id) then
Error_Msg_N ("duplicate global item", Item);
-- Add the entity of the current item to the list of
-- processed items.
else
if No (Seen) then
Seen := New_Elmt_List;
end if;
Append_Elmt (Id, Seen);
end if;
if Ekind (Id) = E_Abstract_State
and then Is_Volatile_State (Id)
then
-- A global item of mode In_Out or Output cannot denote a
-- volatile Input state.
if Is_Input_State (Id)
and then (Global_Mode = Name_In_Out
or else
Global_Mode = Name_Output)
then
Error_Msg_N
("global item of mode In_Out or Output cannot " &
"reference Volatile Input state", Item);
-- A global item of mode In_Out or Input cannot reference
-- a volatile Output state.
elsif Is_Output_State (Id)
and then (Global_Mode = Name_In_Out
or else
Global_Mode = Name_Input)
then
Error_Msg_N
("global item of mode In_Out or Input cannot "
& "reference Volatile Output state", Item);
end if;
end if;
end Analyze_Global_Item;
--------------------------
-- Check_Duplicate_Mode --
--------------------------
procedure Check_Duplicate_Mode
(Mode : Node_Id;
Status : in out Boolean)
is
begin
if Status then
Error_Msg_N ("duplicate global mode", Mode);
end if;
Status := True;
end Check_Duplicate_Mode;
----------------------------------------
-- Check_Mode_Restriction_In_Function --
----------------------------------------
procedure Check_Mode_Restriction_In_Function (Mode : Node_Id) is
begin
if Ekind (Subp_Id) = E_Function then
Error_Msg_Name_1 := Chars (Mode);
Error_Msg_N
("global mode % not applicable to functions", Mode);
end if;
end Check_Mode_Restriction_In_Function;
-- Local variables
Assoc : Node_Id;
Item : Node_Id;
Mode : Node_Id;
-- Start of processing for Analyze_Global_List
begin
-- Single global item declaration
if Nkind_In (List, N_Identifier, N_Selected_Component) then
Analyze_Global_Item (List, Global_Mode);
-- Simple global list or moded global list declaration
elsif Nkind (List) = N_Aggregate then
-- The declaration of a simple global list appear as a
-- collection of expressions.
if Present (Expressions (List)) then
if Present (Component_Associations (List)) then
Error_Msg_N
("cannot mix moded and non-moded global lists",
List);
end if;
Item := First (Expressions (List));
while Present (Item) loop
Analyze_Global_Item (Item, Global_Mode);
Next (Item);
end loop;
-- The declaration of a moded global list appears as a
-- collection of component associations where individual
-- choices denote modes.
elsif Present (Component_Associations (List)) then
if Present (Expressions (List)) then
Error_Msg_N
("cannot mix moded and non-moded global lists",
List);
end if;
Assoc := First (Component_Associations (List));
while Present (Assoc) loop
Mode := First (Choices (Assoc));
if Nkind (Mode) = N_Identifier then
if Chars (Mode) = Name_Contract_In then
Check_Duplicate_Mode (Mode, Contract_Seen);
elsif Chars (Mode) = Name_In_Out then
Check_Duplicate_Mode (Mode, In_Out_Seen);
Check_Mode_Restriction_In_Function (Mode);
elsif Chars (Mode) = Name_Input then
Check_Duplicate_Mode (Mode, Input_Seen);
elsif Chars (Mode) = Name_Output then
Check_Duplicate_Mode (Mode, Output_Seen);
Check_Mode_Restriction_In_Function (Mode);
else
Error_Msg_N ("invalid mode selector", Mode);
end if;
else
Error_Msg_N ("invalid mode selector", Mode);
end if;
-- Items in a moded list appear as a collection of
-- expressions. Reuse the existing machinery to
-- analyze them.
Analyze_Global_List
(List => Expression (Assoc),
Global_Mode => Chars (Mode));
Next (Assoc);
end loop;
-- Something went horribly wrong, we have a malformed tree
else
raise Program_Error;
end if;
-- Any other attempt to declare a global item is erroneous
else
Error_Msg_N ("malformed global list declaration", List);
end if;
end Analyze_Global_List;
-- Local variables
List : Node_Id;
Subp : Node_Id;
-- Start of processing for Global
begin
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
-- Ensure the proper placement of the pragma. Global must be
-- associated with a subprogram declaration.
Subp := Parent (Corresponding_Aspect (N));
if Nkind (Subp) /= N_Subprogram_Declaration then
Pragma_Misplaced;
return;
end if;
Subp_Id := Defining_Unit_Name (Specification (Subp));
List := Expression (Arg1);
-- There is nothing to be done for a null global list
if Nkind (List) = N_Null then
null;
-- Analyze the various forms of global lists and items. Note that
-- some of these may be malformed in which case the analysis emits
-- error messages.
else
Analyze_Global_List (List);
end if;
end Global;
-----------
-- Ident --
-----------
@ -16093,6 +16453,7 @@ package body Sem_Prag is
Pragma_Fast_Math => -1,
Pragma_Finalize_Storage_Only => 0,
Pragma_Float_Representation => 0,
Pragma_Global => -1,
Pragma_Ident => -1,
Pragma_Implementation_Defined => -1,
Pragma_Implemented => -1,

4
gcc/ada/snames.ads-tmpl
View File

@ -494,6 +494,7 @@ package Snames is
Name_Export_Valued_Procedure : constant Name_Id := N + $; -- GNAT
Name_External : constant Name_Id := N + $; -- GNAT
Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT
Name_Global : constant Name_Id := N + $; -- GNAT
Name_Ident : constant Name_Id := N + $; -- VMS
Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT
Name_Implemented : constant Name_Id := N + $; -- Ada 12
@ -673,6 +674,7 @@ package Snames is
Name_Code : constant Name_Id := N + $;
Name_Component : constant Name_Id := N + $;
Name_Component_Size_4 : constant Name_Id := N + $;
Name_Contract_In : constant Name_Id := N + $;
Name_Copy : constant Name_Id := N + $;
Name_D_Float : constant Name_Id := N + $;
Name_Decreases : constant Name_Id := N + $;
@ -695,6 +697,7 @@ package Snames is
Name_GPL : constant Name_Id := N + $;
Name_IEEE_Float : constant Name_Id := N + $;
Name_Ignore : constant Name_Id := N + $;
Name_In_Out : constant Name_Id := N + $;
Name_Increases : constant Name_Id := N + $;
Name_Info : constant Name_Id := N + $;
Name_Integrity : constant Name_Id := N + $;
@ -1771,6 +1774,7 @@ package Snames is
Pragma_Export_Valued_Procedure,
Pragma_External,
Pragma_Finalize_Storage_Only,
Pragma_Global,
Pragma_Ident,
Pragma_Implementation_Defined,
Pragma_Implemented,

7
gcc/ada/table.adb
View File

@ -188,15 +188,12 @@ package body Table is
-- for the use of 10 here is to ensure that the table does really
-- increase in size (which would not be the case for a table of
-- length 10 increased by 3% for instance). Do the intermediate
-- calculation in Long_Long_Integer to avoid overflow. Note that
-- Long_Integer has the same range as Integer on Windows, so we
-- need Long_Long_.
-- calculation in Long_Long_Integer to avoid overflow.
while Max < Last_Val loop
New_Length :=
Long_Long_Integer (Length) *
(100 + Long_Long_Integer (Table_Increment))
/ 100;
(100 + Long_Long_Integer (Table_Increment)) / 100;
Length := Int'Max (Int (New_Length), Length + 10);
Max := Min + Length - 1;
end loop;