diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 898468ce828..707f57acf1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2014-07-16 Robert Dewar + + * snames.ads-tmpl, sem_attr.adb, exp_attr.adb: Same_Storage attribute + is renamed Has_Same_Storage. + * gnat_rm.texi: Document missing SPARK pragmas and attributes. + * sem_prag.adb: Minor comment fix (use LOCAL_NAME in syntax + descriptions). + 2014-07-16 Robert Dewar * exp_util.adb, sem_attr.adb, exp_ch4.adb, a-cohase.ads, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 80e2bf44708..4e191642f3a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3012,6 +3012,73 @@ package body Exp_Attr is Analyze_And_Resolve (N, P_Type); end From_Any; + ---------------------- + -- Has_Same_Storage -- + ---------------------- + + when Attribute_Has_Same_Storage => Has_Same_Storage : declare + Loc : constant Source_Ptr := Sloc (N); + + X : constant Node_Id := Prefix (N); + Y : constant Node_Id := First (Expressions (N)); + -- The arguments + + X_Addr, Y_Addr : Node_Id; + -- Rhe expressions for their addresses + + X_Size, Y_Size : Node_Id; + -- Rhe expressions for their sizes + + begin + -- The attribute is expanded as: + + -- (X'address = Y'address) + -- and then (X'Size = Y'Size) + + -- If both arguments have the same Etype the second conjunct can be + -- omitted. + + X_Addr := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Address, + Prefix => New_Copy_Tree (X)); + + Y_Addr := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Address, + Prefix => New_Copy_Tree (Y)); + + X_Size := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Size, + Prefix => New_Copy_Tree (X)); + + Y_Size := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Size, + Prefix => New_Copy_Tree (Y)); + + if Etype (X) = Etype (Y) then + Rewrite (N, + (Make_Op_Eq (Loc, + Left_Opnd => X_Addr, + Right_Opnd => Y_Addr))); + else + Rewrite (N, + Make_Op_And (Loc, + Left_Opnd => + Make_Op_Eq (Loc, + Left_Opnd => X_Addr, + Right_Opnd => Y_Addr), + Right_Opnd => + Make_Op_Eq (Loc, + Left_Opnd => X_Size, + Right_Opnd => Y_Size))); + end if; + + Analyze_And_Resolve (N, Standard_Boolean); + end Has_Same_Storage; + -------------- -- Identity -- -------------- @@ -4989,73 +5056,6 @@ package body Exp_Attr is when Attribute_Rounding => Expand_Fpt_Attribute_R (N); - ------------------ - -- Same_Storage -- - ------------------ - - when Attribute_Same_Storage => Same_Storage : declare - Loc : constant Source_Ptr := Sloc (N); - - X : constant Node_Id := Prefix (N); - Y : constant Node_Id := First (Expressions (N)); - -- The arguments - - X_Addr, Y_Addr : Node_Id; - -- Rhe expressions for their addresses - - X_Size, Y_Size : Node_Id; - -- Rhe expressions for their sizes - - begin - -- The attribute is expanded as: - - -- (X'address = Y'address) - -- and then (X'Size = Y'Size) - - -- If both arguments have the same Etype the second conjunct can be - -- omitted. - - X_Addr := - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Address, - Prefix => New_Copy_Tree (X)); - - Y_Addr := - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Address, - Prefix => New_Copy_Tree (Y)); - - X_Size := - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Size, - Prefix => New_Copy_Tree (X)); - - Y_Size := - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Size, - Prefix => New_Copy_Tree (Y)); - - if Etype (X) = Etype (Y) then - Rewrite (N, - (Make_Op_Eq (Loc, - Left_Opnd => X_Addr, - Right_Opnd => Y_Addr))); - else - Rewrite (N, - Make_Op_And (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => X_Addr, - Right_Opnd => Y_Addr), - Right_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => X_Size, - Right_Opnd => Y_Size))); - end if; - - Analyze_And_Resolve (N, Standard_Boolean); - end Same_Storage; - ------------- -- Scaling -- ------------- diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index bbe5676ca21..8aa0244bcd2 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -110,6 +110,8 @@ Implementation Defined Pragmas * Pragma Assertion_Policy:: * Pragma Assume:: * Pragma Assume_No_Invalid_Values:: +* Pragma Async_Readers:: +* Pragma Async_Writers:: * Pragma Attribute_Definition:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: @@ -141,6 +143,8 @@ Implementation Defined Pragmas * Pragma Detect_Blocking:: * Pragma Disable_Atomic_Synchronization:: * Pragma Dispatching_Domain:: +* Pragma Effective_Reads:: +* Pragma Effective_Writes:: * Pragma Elaboration_Checks:: * Pragma Eliminate:: * Pragma Enable_Atomic_Synchronization:: @@ -208,6 +212,7 @@ Implementation Defined Pragmas * Pragma Overflow_Mode:: * Pragma Overriding_Renamings:: * Pragma Partition_Elaboration_Policy:: +* Pragma Part_Of:: * Pragma Passive:: * Pragma Persistent_BSS:: * Pragma Polling:: @@ -227,6 +232,9 @@ Implementation Defined Pragmas * Pragma Psect_Object:: * Pragma Pure_Function:: * Pragma Ravenscar:: +* Pragma Refined_Depends:: +* Pragma Refined_Global:: +* Pragma Refined_Post:: * Pragma Refined_State:: * Pragma Relative_Deadline:: * Pragma Remote_Access_Type:: @@ -279,10 +287,14 @@ Implementation Defined Pragmas Implementation Defined Aspects * Aspect Abstract_State:: +* Aspect Async_Readers:: +* Aspect Async_Writers:: * Aspect Contract_Cases:: * Aspect Depends:: * Aspect Dimension:: * Aspect Dimension_System:: +* Aspect Effective_Reads:: +* Aspect Effective_Writes:: * Aspect Favor_Top_Level:: * Aspect Global:: * Aspect Initial_Condition:: @@ -291,9 +303,13 @@ Implementation Defined Aspects * Aspect Invariant:: * Aspect Linker_Section:: * Aspect Object_Size:: +* Aspect Part_Of:: * Aspect Persistent_BSS:: * Aspect Predicate:: * Aspect Pure_Function:: +* Aspect Refined_Depends:: +* Aspect Refined_Global:: +* Aspect Refined_Post:: * Aspect Refined_State:: * Aspect Remote_Access_Type:: * Aspect Scalar_Storage_Order:: @@ -939,6 +955,8 @@ consideration, the use of these pragmas should be minimized. * Pragma Assertion_Policy:: * Pragma Assume:: * Pragma Assume_No_Invalid_Values:: +* Pragma Async_Readers:: +* Pragma Async_Writers:: * Pragma Attribute_Definition:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: @@ -970,6 +988,8 @@ consideration, the use of these pragmas should be minimized. * Pragma Detect_Blocking:: * Pragma Disable_Atomic_Synchronization:: * Pragma Dispatching_Domain:: +* Pragma Effective_Reads:: +* Pragma Effective_Writes:: * Pragma Elaboration_Checks:: * Pragma Eliminate:: * Pragma Enable_Atomic_Synchronization:: @@ -1037,6 +1057,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Overflow_Mode:: * Pragma Overriding_Renamings:: * Pragma Partition_Elaboration_Policy:: +* Pragma Part_Of:: * Pragma Passive:: * Pragma Persistent_BSS:: * Pragma Polling:: @@ -1056,6 +1077,9 @@ consideration, the use of these pragmas should be minimized. * Pragma Psect_Object:: * Pragma Pure_Function:: * Pragma Ravenscar:: +* Pragma Refined_Depends:: +* Pragma Refined_Global:: +* Pragma Refined_Post:: * Pragma Refined_State:: * Pragma Relative_Deadline:: * Pragma Remote_Access_Type:: @@ -1611,6 +1635,20 @@ values will generally give an exception, though formally the program is erroneous so there are no guarantees that this will always be the case, and it is recommended that these two options not be used together. +@node Pragma Async_Readers +@unnumberedsec Pragma Async_Readers +@findex Async_Readers +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.1.2. + +@node Pragma Async_Writers +@unnumberedsec Pragma Async_Writers +@findex Async_Writers +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.1.2. + @node Pragma Ast_Entry @unnumberedsec Pragma Ast_Entry @cindex OpenVMS @@ -2540,6 +2578,20 @@ This pragma is standard in Ada 2012, but is available in all earlier versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. +@node Pragma Effective_Reads +@unnumberedsec Pragma Effective_Reads +@findex Effective_Reads +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.1.2. + +@node Pragma Effective_Writes +@unnumberedsec Pragma Effective_Writes +@findex Effective_Writes +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.1.2. + @node Pragma Elaboration_Checks @unnumberedsec Pragma Elaboration_Checks @cindex Elaboration control @@ -5117,6 +5169,13 @@ This pragma is standard in Ada 2005, but is available in all earlier versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. +@node Pragma Part_Of +@unnumberedsec Pragma Part_Of +@findex Part_Of +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.2.6. + @node Pragma Passive @unnumberedsec Pragma Passive @findex Passive @@ -5956,6 +6015,27 @@ pragma Profile (Ravenscar); @noindent which is the preferred method of setting the @code{Ravenscar} profile. +@node Pragma Refined_Depends +@unnumberedsec Pragma Refined_Depends +@findex Refined_Depends +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 6.1.5. + +@node Pragma Refined_Global +@unnumberedsec Pragma Refined_Global +@findex Refined_Global +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 6.1.4. + +@node Pragma Refined_Post +@unnumberedsec Pragma Refined_Post +@findex Refined_Post +@noindent +For the description of this pragma, see SPARK 2014 Reference Manual, +section 7.2.7. + @node Pragma Refined_State @unnumberedsec Pragma Refined_State @findex Refined_State @@ -7817,10 +7897,14 @@ clause. @menu * Aspect Abstract_State:: +* Aspect Async_Readers:: +* Aspect Async_Writers:: * Aspect Contract_Cases:: * Aspect Depends:: * Aspect Dimension:: * Aspect Dimension_System:: +* Aspect Effective_Reads:: +* Aspect Effective_Writes:: * Aspect Favor_Top_Level:: * Aspect Global:: * Aspect Initial_Condition:: @@ -7830,9 +7914,13 @@ clause. * Aspect Linker_Section:: * Aspect Lock_Free:: * Aspect Object_Size:: +* Aspect Part_Of:: * Aspect Persistent_BSS:: * Aspect Predicate:: * Aspect Pure_Function:: +* Aspect Refined_Depends:: +* Aspect Refined_Global:: +* Aspect Refined_Post:: * Aspect Refined_State:: * Aspect Remote_Access_Type:: * Aspect Scalar_Storage_Order:: @@ -7858,6 +7946,18 @@ clause. @noindent This aspect is equivalent to pragma @code{Abstract_State}. +@node Aspect Async_Readers +@unnumberedsec Aspect Async_Readers +@findex Async_Readers +@noindent +This aspect is equivalent to pragma @code{Async_Readers}. + +@node Aspect Async_Writers +@unnumberedsec Aspect Async_Writers +@findex Async_Writers +@noindent +This aspect is equivalent to pragma @code{Async_Writers}. + @node Aspect Contract_Cases @unnumberedsec Aspect Contract_Cases @findex Contract_Cases @@ -7962,6 +8062,18 @@ following aspect: See section ``Performing Dimensionality Analysis in GNAT'' in the GNAT Users Guide for detailed examples of use of the dimension system. +@node Aspect Effective_Reads +@unnumberedsec Aspect Effective_Reads +@findex Effective_Reads +@noindent +This aspect is equivalent to pragma @code{Effective_Reads}. + +@node Aspect Effective_Writes +@unnumberedsec Aspect Effective_Writes +@findex Effective_Writes +@noindent +This aspect is equivalent to pragma @code{Effective_Writes}. + @node Aspect Favor_Top_Level @unnumberedsec Aspect Favor_Top_Level @findex Favor_Top_Level @@ -8019,6 +8131,12 @@ This aspect is equivalent to pragma @code{Lock_Free}. This aspect is equivalent to an @code{Object_Size} attribute definition clause. +@node Aspect Part_Of +@unnumberedsec Aspect Part_Of +@findex Part_Of +@noindent +This aspect is equivalent to pragma @code{Part_Of}. + @node Aspect Persistent_BSS @unnumberedsec Aspect Persistent_BSS @findex Persistent_BSS @@ -8042,6 +8160,24 @@ expression. It is also separately controllable using pragma @noindent This aspect is equivalent to pragma @code{Pure_Function}. +@node Aspect Refined_Depends +@unnumberedsec Aspect Refined_Depends +@findex Refined_Depends +@noindent +This aspect is equivalent to pragma @code{Refined_Depends}. + +@node Aspect Refined_Global +@unnumberedsec Aspect Refined_Global +@findex Refined_Global +@noindent +This aspect is equivalent to pragma @code{Refined_Global}. + +@node Aspect Refined_Post +@unnumberedsec Aspect Refined_Post +@findex Refined_Post +@noindent +This aspect is equivalent to pragma @code{Refined_Post}. + @node Aspect Refined_State @unnumberedsec Aspect Refined_State @findex Refined_State diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 371bb063fe3..22e2d5ba4b0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3550,6 +3550,22 @@ package body Sem_Attr is Check_E0; Set_Etype (N, Standard_Boolean); + ---------------------- + -- Has_Same_Storage -- + ---------------------- + + when Attribute_Has_Same_Storage => + Check_Ada_2012_Attribute; + Check_E1; + + -- The arguments must be objects of any type + + Analyze_And_Resolve (P); + Analyze_And_Resolve (E1); + Check_Object_Reference (P); + Check_Object_Reference (E1); + Set_Etype (N, Standard_Boolean); + ----------------------- -- Has_Tagged_Values -- ----------------------- @@ -5407,22 +5423,6 @@ package body Sem_Attr is Check_Real_Type; Set_Etype (N, Universal_Real); - ------------------ - -- Same_Storage -- - ------------------ - - when Attribute_Same_Storage => - Check_Ada_2012_Attribute; - Check_E1; - - -- The arguments must be objects of any type - - Analyze_And_Resolve (P); - Analyze_And_Resolve (E1); - Check_Object_Reference (P); - Check_Object_Reference (E1); - Set_Etype (N, Standard_Boolean); - -------------------------- -- Scalar_Storage_Order -- -------------------------- @@ -7964,6 +7964,13 @@ package body Sem_Attr is Boolean_Literals (Has_Discriminants (P_Entity)), Loc)); Analyze_And_Resolve (N, Standard_Boolean); + ---------------------- + -- Has_Same_Storage -- + ---------------------- + + when Attribute_Has_Same_Storage => + null; + ----------------------- -- Has_Tagged_Values -- ----------------------- @@ -8866,13 +8873,6 @@ package body Sem_Attr is Fold_Ureal (N, Model_Small_Value (P_Type), Static); end if; - ------------------ - -- Same_Storage -- - ------------------ - - when Attribute_Same_Storage => - null; - ----------- -- Scale -- ----------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f95fb3b12c9..bd75f02834f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11491,10 +11491,12 @@ package body Sem_Prag is -- Async_Readers/Async_Writers/Effective_Reads/Effective_Writes -- ------------------------------------------------------------------ - -- pragma Asynch_Readers ( identifier [, boolean_EXPRESSION] ); - -- pragma Asynch_Writers ( identifier [, boolean_EXPRESSION] ); - -- pragma Effective_Reads ( identifier [, boolean_EXPRESSION] ); - -- pragma Effective_Writes ( identifier [, boolean_EXPRESSION] ); + -- pragma Asynch_Readers ( object_LOCAL_NAME [, FLAG] ); + -- pragma Asynch_Writers ( object_LOCAL_NAME [, FLAG] ); + -- pragma Effective_Reads ( object_LOCAL_NAME [, FLAG] ); + -- pragma Effective_Writes ( object_LOCAL_NAME [, FLAG] ); + + -- FLAG ::= boolean_EXPRESSION when Pragma_Async_Readers | Pragma_Async_Writers | @@ -12635,7 +12637,7 @@ package body Sem_Prag is -- CPP_Class -- --------------- - -- pragma CPP_Class ([Entity =>] local_NAME) + -- pragma CPP_Class ([Entity =>] LOCAL_NAME) when Pragma_CPP_Class => CPP_Class : declare begin @@ -13606,7 +13608,7 @@ package body Sem_Prag is -- pragma Export ( -- [ Convention =>] convention_IDENTIFIER, - -- [ Entity =>] local_NAME + -- [ Entity =>] LOCAL_NAME -- [, [External_Name =>] static_string_EXPRESSION ] -- [, [Link_Name =>] static_string_EXPRESSION ]); @@ -14044,7 +14046,7 @@ package body Sem_Prag is -- pragma External ( -- [ Convention =>] convention_IDENTIFIER, - -- [ Entity =>] local_NAME + -- [ Entity =>] LOCAL_NAME -- [, [External_Name =>] static_string_EXPRESSION ] -- [, [Link_Name =>] static_string_EXPRESSION ]); @@ -14491,7 +14493,7 @@ package body Sem_Prag is -- Implementation_Defined -- ---------------------------- - -- pragma Implementation_Defined (local_NAME); + -- pragma Implementation_Defined (LOCAL_NAME); -- Marks previously declared entity as implementation defined. For -- an overloaded entity, applies to the most recent homonym. @@ -14645,7 +14647,7 @@ package body Sem_Prag is -- pragma Import ( -- [Convention =>] convention_IDENTIFIER, - -- [Entity =>] local_NAME + -- [Entity =>] LOCAL_NAME -- [, [External_Name =>] static_string_EXPRESSION ] -- [, [Link_Name =>] static_string_EXPRESSION ]); @@ -15343,7 +15345,7 @@ package body Sem_Prag is -- pragma Interface ( -- [ Convention =>] convention_IDENTIFIER, - -- [ Entity =>] local_NAME + -- [ Entity =>] LOCAL_NAME -- [, [External_Name =>] static_string_EXPRESSION ] -- [, [Link_Name =>] static_string_EXPRESSION ]); @@ -15379,7 +15381,7 @@ package body Sem_Prag is -------------------- -- pragma Interface_Name ( - -- [ Entity =>] local_NAME + -- [ Entity =>] LOCAL_NAME -- [,[External_Name =>] static_string_EXPRESSION ] -- [,[Link_Name =>] static_string_EXPRESSION ]); @@ -16093,7 +16095,7 @@ package body Sem_Prag is -- Keep_Names -- ---------------- - -- pragma Keep_Names ([On => ] local_NAME); + -- pragma Keep_Names ([On => ] LOCAL_NAME); when Pragma_Keep_Names => Keep_Names : declare Arg : Node_Id; @@ -17517,7 +17519,7 @@ package body Sem_Prag is -- pragma Part_Of (ABSTRACT_STATE); - -- ABSTRACT_STATE ::= name + -- ABSTRACT_STATE ::= NAME when Pragma_Part_Of => Part_Of : declare procedure Propagate_Part_Of @@ -20902,7 +20904,7 @@ package body Sem_Prag is -- Unmodified -- ---------------- - -- pragma Unmodified (local_Name {, local_Name}); + -- pragma Unmodified (LOCAL_NAME {, LOCAL_NAME}); when Pragma_Unmodified => Unmodified : declare Arg_Node : Node_Id; @@ -20950,7 +20952,7 @@ package body Sem_Prag is -- Unreferenced -- ------------------ - -- pragma Unreferenced (local_Name {, local_Name}); + -- pragma Unreferenced (LOCAL_NAME {, LOCAL_NAME}); -- or when used in a context clause: @@ -21045,7 +21047,7 @@ package body Sem_Prag is -- Unreferenced_Objects -- -------------------------- - -- pragma Unreferenced_Objects (local_Name {, local_Name}); + -- pragma Unreferenced_Objects (LOCAL_NAME {, LOCAL_NAME}); when Pragma_Unreferenced_Objects => Unreferenced_Objects : declare Arg_Node : Node_Id; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 40202f2a3a0..ec99f317bf8 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -868,6 +868,7 @@ package Snames is Name_Fore : constant Name_Id := N + $; Name_Has_Access_Values : constant Name_Id := N + $; -- GNAT Name_Has_Discriminants : constant Name_Id := N + $; -- GNAT + Name_Has_Same_Storage : constant Name_Id := N + $; -- Ada 12 Name_Has_Tagged_Values : constant Name_Id := N + $; -- GNAT Name_Identity : constant Name_Id := N + $; Name_Img : constant Name_Id := N + $; -- GNAT @@ -925,7 +926,6 @@ package Snames is Name_Safe_Large : constant Name_Id := N + $; -- Ada 83 Name_Safe_Last : constant Name_Id := N + $; Name_Safe_Small : constant Name_Id := N + $; -- Ada 83 - Name_Same_Storage : constant Name_Id := N + $; -- Ada 12 Name_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT Name_Scale : constant Name_Id := N + $; Name_Scaling : constant Name_Id := N + $; @@ -1494,6 +1494,7 @@ package Snames is Attribute_Fore, Attribute_Has_Access_Values, Attribute_Has_Discriminants, + Attribute_Has_Same_Storage, Attribute_Has_Tagged_Values, Attribute_Identity, Attribute_Img, @@ -1551,7 +1552,6 @@ package Snames is Attribute_Safe_Large, Attribute_Safe_Last, Attribute_Safe_Small, - Attribute_Same_Storage, Attribute_Scalar_Storage_Order, Attribute_Scale, Attribute_Scaling,