[multiple changes]
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
parent
2a328c94e1
commit
7a1f177500
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -1156,6 +1156,7 @@ begin
|
|||
Pragma_Fast_Math |
|
||||
Pragma_Finalize_Storage_Only |
|
||||
Pragma_Float_Representation |
|
||||
Pragma_Global |
|
||||
Pragma_Ident |
|
||||
Pragma_Implementation_Defined |
|
||||
Pragma_Implemented |
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue