diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
| -rw-r--r-- | gcc/ada/aspects.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/aspects.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/par-ch13.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 363 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 4 | ||||
| -rw-r--r-- | gcc/ada/table.adb | 7 |
11 files changed, 480 insertions, 22 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e83215..0b0bdfd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 5156b9d..523deaa 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index c2e3d67..94c3c61 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -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, diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index d3ed851..4d63d0e 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -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 diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 0427a5b..313567b 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1156,6 +1156,7 @@ begin Pragma_Fast_Math | Pragma_Finalize_Storage_Only | Pragma_Float_Representation | + Pragma_Global | Pragma_Ident | Pragma_Implementation_Defined | Pragma_Implemented | diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 6f2dd2e..2e04d60 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 124769d..f2bcfa8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 - - when Aspect_Address => - T := RTE (RE_Address); - - when Aspect_Bit_Order | Aspect_Scalar_Storage_Order => - T := RTE (RE_Bit_Order); + -- Default_Value is resolved with the type entity in question - 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ac0e0cc..ead2e64 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 13d8be5..2595b75 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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, diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index d350c70..4fbf069 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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, diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index a7fdd55..e6367af 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -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; |