From: Arnaud Charlet Date: Fri, 22 May 2015 10:11:36 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=eb9008b7557ace9f273c3fa2372dbe99a9b2b9b3;p=gcc.git [multiple changes] 2015-05-22 Robert Dewar * a-reatim.ads: Add Compile_Time_Error to ensure Duration is 64-bits. * sem_ch13.adb: Improve error message. * exp_ch4.adb: Minor reformatting. 2015-05-22 Hristian Kirtchev * sem_prag.adb (Analyze_Pragma): Constants without variable input do not require indicator Part_Of. (Check_Missing_Part_Of): Constants without variable input do not requrie indicator Part_Of. (Collect_Visible_States): Constants without variable input are not part of the hidden state of a package. * sem_util.ads, sem_util.adb (Has_Variable_Input): New routine. From-SVN: r223531 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2feb579a86e..e4320981b14 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,11 +1,28 @@ -2015-05-21 Robert Dewar +2015-05-22 Robert Dewar + + * a-reatim.ads: Add Compile_Time_Error to ensure Duration + is 64-bits. + * sem_ch13.adb: Improve error message. + * exp_ch4.adb: Minor reformatting. + +2015-05-22 Hristian Kirtchev + + * sem_prag.adb (Analyze_Pragma): Constants without variable + input do not require indicator Part_Of. + (Check_Missing_Part_Of): Constants without variable input do not + requrie indicator Part_Of. + (Collect_Visible_States): Constants without variable input are + not part of the hidden state of a package. + * sem_util.ads, sem_util.adb (Has_Variable_Input): New routine. + +2015-05-22 Robert Dewar * exp_util.adb (Activate_Atomic_Synchronization): Do not set Atomic_Sync_Required for an object renaming declaration. * sem_ch8.adb (Analyze_Object_Renaming): Copy Is_Atomic and Is_Independent to renaming object. -2015-05-21 Ed Schonberg +2015-05-22 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification): Diagnose various illegalities in iterators over arrays and containers: diff --git a/gcc/ada/a-reatim.ads b/gcc/ada/a-reatim.ads index 4fbe7be54cf..7abbeb843d2 100644 --- a/gcc/ada/a-reatim.ads +++ b/gcc/ada/a-reatim.ads @@ -38,6 +38,10 @@ pragma Elaborate_All (System.Task_Primitives.Operations); package Ada.Real_Time is + pragma Compile_Time_Error + (Duration'Size /= 64, + "this version of Ada.Real_Time requires 64-bit Duration"); + type Time is private; Time_First : constant Time; Time_Last : constant Time; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8b3e0ea511b..076bfafafcc 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7688,12 +7688,13 @@ package body Exp_Ch4 is begin if (Nkind (P) = N_Op_Multiply - and then not Non_Binary_Modulus (Typ) - and then - ((Is_Integer_Type (Etype (L)) and then R = N) - or else - (Is_Integer_Type (Etype (R)) and then L = N)) - and then not Do_Overflow_Check (P)) + and then not Non_Binary_Modulus (Typ) + and then + ((Is_Integer_Type (Etype (L)) and then R = N) + or else + (Is_Integer_Type (Etype (R)) and then L = N)) + and then not Do_Overflow_Check (P)) + or else (Nkind (P) = N_Op_Divide and then Is_Integer_Type (Etype (L)) @@ -7706,7 +7707,7 @@ package body Exp_Ch4 is end if; end; - -- Now the other cases + -- Now the other cases where we convert to 1 * (2 ** K) elsif not Non_Binary_Modulus (Typ) then Rewrite (N, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1de87d9fc57..e985e93f10d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3890,28 +3890,42 @@ package body Sem_Ch13 is elsif No (Next_Formal (First_Formal (Subp))) then Illegal_Indexing - ("indexing function must have at least two parameters"); + ("indexing function must have at least two parameters"); return; elsif Is_Derived_Type (Ent) then - if (Attr = Name_Constant_Indexing - and then Present - (Find_Aspect (Etype (Ent), Aspect_Constant_Indexing))) - or else - (Attr = Name_Variable_Indexing - and then Present - (Find_Aspect (Etype (Ent), Aspect_Variable_Indexing))) - then - if Debug_Flag_Dot_XX then - null; + declare + Inherited : Node_Id; - else - Illegal_Indexing - ("indexing function already inherited " - & "from parent type"); - return; + begin + if Attr = Name_Constant_Indexing then + Inherited := + Find_Aspect (Etype (Ent), Aspect_Constant_Indexing); + elsif Attr = Name_Variable_Indexing then + Inherited := + Find_Aspect (Etype (Ent), Aspect_Variable_Indexing); end if; - end if; + + -- What if neither branch taken above ??? + + if Present (Inherited) then + if Debug_Flag_Dot_XX then + null; + + -- Indicate the operation that must be overridden, + -- rather than redefining the indexing aspect + + else + Illegal_Indexing + ("indexing function already inherited " + & "from parent type"); + Error_Msg_NE + ("!override& instead", + N, Entity (Expression (Inherited))); + return; + end if; + end if; + end; end if; if not Check_Primitive_Function (Subp) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 7fb33b49cb0..bdd2eec2466 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2710,7 +2710,7 @@ package body Sem_Prag is Legal : out Boolean); -- Subsidiary to the analysis of pragmas Abstract_State and Part_Of. -- Perform full analysis of indicator Part_Of. Item_Id is the entity of - -- an abstract state, variable or package instantiation. State is the + -- an abstract state, object or package instantiation. State is the -- encapsulating state. Indic is the Part_Of indicator. Flag Legal is -- set when the indicator is legal. @@ -17557,6 +17557,20 @@ package body Sem_Prag is Legal => Legal); if Legal then + + -- Constants without "variable input" are not considered part + -- of the hidden state of a package (SPARK RM 7.1.1(2)). As a + -- result such constants do not require a Part_Of indicator. + + if Ekind (Item_Id) = E_Constant + and then not Has_Variable_Input (Item_Id) + then + SPARK_Msg_NE + ("useless Part_Of indicator, constant & does not have " + & "variable input", N, Item_Id); + return; + end if; + State_Id := Entity (State); -- The Part_Of indicator turns an object into a constituent of @@ -24448,7 +24462,18 @@ package body Sem_Prag is -- formals to their actuals as the formals cannot be named -- from the outside and participate in refinement. - if No (Corresponding_Generic_Association (Decl)) then + if Present (Corresponding_Generic_Association (Decl)) then + null; + + -- Constants without "variable input" are not considered a + -- hidden state of a package (SPARK RM 7.1.1(2)). + + elsif Ekind (Item_Id) = E_Constant + and then not Has_Variable_Input (Item_Id) + then + null; + + else Add_Item (Item_Id, Result); end if; @@ -24993,6 +25018,14 @@ package body Sem_Prag is elsif SPARK_Mode /= On then return; + + -- Do not consider constants without variable input because those are + -- not part of the hidden state of a package (SPARK RM 7.1.1(2)). + + elsif Ekind (Item_Id) = E_Constant + and then not Has_Variable_Input (Item_Id) + then + return; end if; -- Find where the abstract state, variable or package instantiation diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 716c2d84c3e..196310f3651 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -9317,6 +9317,18 @@ package body Sem_Util is end if; end Has_Tagged_Component; + ------------------------ + -- Has_Variable_Input -- + ------------------------ + + function Has_Variable_Input (Const_Id : Entity_Id) return Boolean is + Expr : constant Node_Id := Expression (Declaration_Node (Const_Id)); + + begin + return + Present (Expr) and then not Compile_Time_Known_Value_Or_Aggr (Expr); + end Has_Variable_Input; + ---------------------------- -- Has_Volatile_Component -- ---------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 910b282d4d4..4255e9624ac 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1046,6 +1046,11 @@ package Sem_Util is -- component is present. This function is used to check if "=" has to be -- expanded into a bunch component comparisons. + function Has_Variable_Input (Const_Id : Entity_Id) return Boolean; + -- Determine whether the initialization expression of constant Const_Id has + -- "variable input" (SPARK RM 7.1.1(2)). This roughly maps to the semantic + -- concept of a compile-time known value. + function Has_Volatile_Component (Typ : Entity_Id) return Boolean; -- Given an arbitrary type, determine whether it contains at least one -- volatile component.