2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>

	* sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs
	for subunit in generic units.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Check_A_Call): Avoid checking internal call
	from Valid_Scalars

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): An untagged incomplete type
	is legal in the profile of a null procedure.

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly
	the checks on a derived formal whose parent type is a previous
	formal that is not a derived type.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb: Add entries for aspect Volatile_Full_Access
	* einfo.adb (Has_Volatile_Full_Access): New flag.
	(Has_Volatile_Full_Access): New flag.
	* einfo.ads (Has_Volatile_Full_Access): New flag.
	* par-prag.adb: Add dummy entry for Volatile_Full_Access.
	* sem_prag.adb (Analyze_Pragma, case Volatile_Full_Access):
	Implement new pragma.
	* snames.ads-tmpl: Add entries for pragma Volatile_Full_Access.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* targparm.ads: Minor reformatting.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* a-reatim.adb (Time_Of): Properly detect overflow when TS = 0.0.
	* a-reatim.ads: Minor reformatting.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223074 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a9666ff..e189279 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,44 @@
+2015-05-12  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+       * sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs
+       for subunit in generic units.
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * sem_elab.adb (Check_A_Call): Avoid checking internal call
+       from Valid_Scalars
+
+2015-05-12  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb (Process_Formals): An untagged incomplete type
+       is legal in the profile of a null procedure.
+
+2015-05-12  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly
+       the checks on a derived formal whose parent type is a previous
+       formal that is not a derived type.
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * aspects.ads, aspects.adb: Add entries for aspect Volatile_Full_Access
+       * einfo.adb (Has_Volatile_Full_Access): New flag.
+       (Has_Volatile_Full_Access): New flag.
+       * einfo.ads (Has_Volatile_Full_Access): New flag.
+       * par-prag.adb: Add dummy entry for Volatile_Full_Access.
+       * sem_prag.adb (Analyze_Pragma, case Volatile_Full_Access):
+       Implement new pragma.
+       * snames.ads-tmpl: Add entries for pragma Volatile_Full_Access.
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * targparm.ads: Minor reformatting.
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * a-reatim.adb (Time_Of): Properly detect overflow when TS = 0.0.
+       * a-reatim.ads: Minor reformatting.
+
 2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * einfo.ads: Update the documentation of flags

diff --git a/gcc/ada/a-reatim.adb b/gcc/ada/a-reatim.adb
index 52aa9f3..c313d50 100644 (file)
--- a/gcc/ada/a-reatim.adb
+++ b/gcc/ada/a-reatim.adb
@@ -228,6 +228,28 @@ package body Ada.Real_Time is
 
    function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
    begin
+      --  Simple case first, TS = 0.0, we need to make sure SC is in range
+
+      if TS = 0.0 then
+         if SC >= Seconds_Count (Duration (Time_Span_First) + Duration'(0.5))
+               and then
+            SC <= Seconds_Count (Duration (Time_Span_Last)  - Duration'(0.5))
+         then
+            --  Don't need any further checks after that manual check
+
+            declare
+               pragma Suppress (All_Checks);
+            begin
+               return Time (SC);
+            end;
+
+         --  Here we have a Seconds_Count value that is out of range
+
+         else
+            raise Constraint_Error;
+         end if;
+      end if;
+
       --  We want to return Time (SC) + TS. To avoid spurious overflows in
       --  the intermediate result Time (SC) we take advantage of the different
       --  signs in SC and TS (when that is the case).

diff --git a/gcc/ada/a-reatim.ads b/gcc/ada/a-reatim.ads
index 8558d46..4fbe7be 100644 (file)
--- a/gcc/ada/a-reatim.ads
+++ b/gcc/ada/a-reatim.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -91,18 +91,23 @@ package Ada.Real_Time is
    pragma Ada_05 (Minutes);
 
    type Seconds_Count is new Long_Long_Integer;
-   --  Seconds_Count needs 64 bits, since Time has the full range of
+   --  Seconds_Count needs 64 bits, since the type Time has the full range of
    --  Duration. The delta of Duration is 10 ** (-9), so the maximum number of
    --  seconds is 2**63/10**9 = 8*10**9 which does not quite fit in 32 bits.
    --  However, rather than make this explicitly 64-bits we derive from
-   --  Long_Long_Integer. In normal usage this will have the same effect.
-   --  But in the case of CodePeer with a target configuration file with a
-   --  maximum integer size of 32, it allows analysis of this unit.
+   --  Long_Long_Integer. In normal usage this will have the same effect. But
+   --  in the case of CodePeer with a target configuration file with a maximum
+   --  integer size of 32, it allows analysis of this unit.
 
    procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span);
    function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time;
 
 private
+   --  Time and Time_Span are represented in 64-bit Duration value in
+   --  nanoseconds. For example, 1 second and 1 nanosecond is represented
+   --  as the stored integer 1_000_000_001. This is for the 64-bit Duration
+   --  case, not clear if this also is used for 32-bit Duration values.
+
    type Time is new Duration;
 
    Time_First : constant Time := Time'First;
@@ -122,10 +127,6 @@ private
    Tick : constant Time_Span :=
             Time_Span (System.Task_Primitives.Operations.RT_Resolution);
 
-   --  Time and Time_Span are represented in 64-bit Duration value in
-   --  nanoseconds. For example, 1 second and 1 nanosecond is represented
-   --  as the stored integer 1_000_000_001.
-
    pragma Import (Intrinsic, "<");
    pragma Import (Intrinsic, "<=");
    pragma Import (Intrinsic, ">");

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index bef432f..976b89d 100644 (file)
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -55,6 +55,7 @@ package body Aspects is
       Aspect_Unchecked_Union         => True,
       Aspect_Variable_Indexing       => True,
       Aspect_Volatile                => True,
+      Aspect_Volatile_Full_Access    => True,
       others                         => False);
 
    --  The following array indicates type aspects that are inherited and apply
@@ -606,6 +607,7 @@ package body Aspects is
     Aspect_Value_Size                   => Aspect_Value_Size,
     Aspect_Volatile                     => Aspect_Volatile,
     Aspect_Volatile_Components          => Aspect_Volatile_Components,
+    Aspect_Volatile_Full_Access         => Aspect_Volatile_Full_Access,
     Aspect_Warnings                     => Aspect_Warnings,
     Aspect_Write                        => Aspect_Write);
 

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 049efae..41fa961 100644 (file)
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -201,7 +201,8 @@ package Aspects is
       Aspect_Unreferenced,                  -- GNAT
       Aspect_Unreferenced_Objects,          -- GNAT
       Aspect_Volatile,
-      Aspect_Volatile_Components);
+      Aspect_Volatile_Components,
+      Aspect_Volatile_Full_Access);         -- GNAT
 
    subtype Aspect_Id_Exclude_No_Aspect is
      Aspect_Id range Aspect_Id'Succ (No_Aspect) .. Aspect_Id'Last;
@@ -503,6 +504,7 @@ package Aspects is
       Aspect_Variable_Indexing            => Name_Variable_Indexing,
       Aspect_Volatile                     => Name_Volatile,
       Aspect_Volatile_Components          => Name_Volatile_Components,
+      Aspect_Volatile_Full_Access         => Name_Volatile_Full_Access,
       Aspect_Warnings                     => Name_Warnings,
       Aspect_Write                        => Name_Write);
 
@@ -737,7 +739,8 @@ package Aspects is
       Aspect_Storage_Size                 => Rep_Aspect,
       Aspect_Value_Size                   => Rep_Aspect,
       Aspect_Volatile                     => Rep_Aspect,
-      Aspect_Volatile_Components          => Rep_Aspect);
+      Aspect_Volatile_Components          => Rep_Aspect,
+      Aspect_Volatile_Full_Access         => Rep_Aspect);
 
    ------------------------------------------------
    -- Handling of Aspect Specifications on Stubs --

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index f364960..af85c2b 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -591,8 +591,8 @@ package body Einfo is
    --    Has_Nested_Subprogram           Flag282
    --    Is_Uplevel_Referenced_Entity    Flag283
    --    Is_Unimplemented                Flag284
+   --    Has_Volatile_Full_Access        Flag285
 
-   --    (unused)                        Flag285
    --    (unused)                        Flag286
    --    (unused)                        Flag287
    --    (unused)                        Flag288
@@ -1849,6 +1849,11 @@ package body Einfo is
       return Flag87 (Implementation_Base_Type (Id));
    end Has_Volatile_Components;
 
+   function Has_Volatile_Full_Access (Id : E) return B is
+   begin
+      return Flag285 (Id);
+   end Has_Volatile_Full_Access;
+
    function Has_Xref_Entry (Id : E) return B is
    begin
       return Flag182 (Id);
@@ -4730,6 +4735,11 @@ package body Einfo is
       Set_Flag87 (Id, V);
    end Set_Has_Volatile_Components;
 
+   procedure Set_Has_Volatile_Full_Access (Id : E; V : B := True) is
+   begin
+      Set_Flag285 (Id, V);
+   end Set_Has_Volatile_Full_Access;
+
    procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
    begin
       Set_Flag182 (Id, V);
@@ -8695,6 +8705,7 @@ package body Einfo is
       W ("Has_Uplevel_Reference",           Flag215 (Id));
       W ("Has_Visible_Refinement",          Flag263 (Id));
       W ("Has_Volatile_Components",         Flag87  (Id));
+      W ("Has_Volatile_Full_Access",        Flag285 (Id));
       W ("Has_Xref_Entry",                  Flag182 (Id));
       W ("In_Package_Body",                 Flag48  (Id));
       W ("In_Private_Part",                 Flag45  (Id));

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7a068f2..bf21f76 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2046,6 +2046,12 @@ package Einfo is
 --       type the pragma will be chained to the rep item chain of the first
 --       subtype in the usual manner.
 
+--    Has_Volatile_Full_Access (Flag285)
+--       Defined in all type entities, and also in constants, components and
+--       variables. Set if a pragma Volatile_Full_Access applies to the entity.
+--       In the case of private and incomplete types, this flag is set in
+--       both the partial view and the full view.
+
 --    Has_Xref_Entry (Flag182)
 --       Defined in all entities. Set if an entity has an entry in the Xref
 --       information generated in ali files. This is true for all source
@@ -5412,6 +5418,7 @@ package Einfo is
    --    Has_Task                            (Flag30)   (base type only)
    --    Has_Unchecked_Union                 (Flag123)  (base type only)
    --    Has_Volatile_Components             (Flag87)   (base type only)
+   --    Has_Volatile_Full_Access            (Flag285)
    --    In_Use                              (Flag8)
    --    Is_Abstract_Type                    (Flag146)
    --    Is_Asynchronous                     (Flag81)
@@ -5423,10 +5430,10 @@ package Einfo is
    --    Is_Frozen                           (Flag4)
    --    Is_Generic_Actual_Type              (Flag94)
    --    Is_Independent                      (Flag268)
-   --    Is_RACW_Stub_Type                   (Flag244)
    --    Is_Non_Static_Subtype               (Flag109)
    --    Is_Packed                           (Flag51)   (base type only)
    --    Is_Private_Composite                (Flag107)
+   --    Is_RACW_Stub_Type                   (Flag244)
    --    Is_Unsigned_Type                    (Flag144)
    --    Is_Volatile                         (Flag16)
    --    Itype_Printed                       (Flag202)  (itypes only)
@@ -5595,12 +5602,13 @@ package Einfo is
    --    Related_Type                        (Node27)
    --    Has_Biased_Representation           (Flag139)
    --    Has_Per_Object_Constraint           (Flag154)
+   --    Has_Volatile_Full_Access            (Flag285)
    --    Is_Atomic                           (Flag85)
    --    Is_Independent                      (Flag268)
+   --    Is_Return_Object                    (Flag209)
    --    Is_Tag                              (Flag78)
    --    Is_Volatile                         (Flag16)
    --    Treat_As_Volatile                   (Flag41)
-   --    Is_Return_Object                    (Flag209)
    --    Next_Component                      (synth)
    --    Next_Component_Or_Discriminant      (synth)
 
@@ -5633,6 +5641,7 @@ package Einfo is
    --    Has_Size_Clause                     (Flag29)
    --    Has_Thunks                          (Flag228)  (constants only)
    --    Has_Volatile_Components             (Flag87)
+   --    Has_Volatile_Full_Access            (Flag285)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
    --    Is_Independent                      (Flag268)
@@ -5641,9 +5650,9 @@ package Einfo is
    --    Is_True_Constant                    (Flag163)
    --    Is_Uplevel_Referenced_Entity        (Flag283)
    --    Is_Volatile                         (Flag16)
-   --    Stores_Attribute_Old_Prefix         (Flag270)  (constants only)
    --    Optimize_Alignment_Space            (Flag241)  (constants only)
    --    Optimize_Alignment_Time             (Flag242)  (constants only)
+   --    Stores_Attribute_Old_Prefix         (Flag270)  (constants only)
    --    Treat_As_Volatile                   (Flag41)
    --    Address_Clause                      (synth)
    --    Alignment_Clause                    (synth)
@@ -6364,16 +6373,17 @@ package Einfo is
    --    Has_Initial_Value                   (Flag219)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Volatile_Components             (Flag87)
+   --    Has_Volatile_Full_Access            (Flag285)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
    --    Is_Independent                      (Flag268)
    --    Is_Processed_Transient              (Flag252)
+   --    Is_Return_Object                    (Flag209)
    --    Is_Safe_To_Reevaluate               (Flag249)
    --    Is_Shared_Passive                   (Flag60)
    --    Is_True_Constant                    (Flag163)
-   --    Is_Volatile                         (Flag16)
-   --    Is_Return_Object                    (Flag209)
    --    Is_Uplevel_Referenced_Entity        (Flag283)
+   --    Is_Volatile                         (Flag16)
    --    OK_To_Rename                        (Flag247)
    --    Optimize_Alignment_Space            (Flag241)
    --    Optimize_Alignment_Time             (Flag242)
@@ -6630,12 +6640,11 @@ package Einfo is
    function Associated_Node_For_Itype           (Id : E) return N;
    function Associated_Storage_Pool             (Id : E) return E;
    function Barrier_Function                    (Id : E) return N;
+   function BIP_Initialization_Call             (Id : E) return N;
    function Block_Node                          (Id : E) return N;
    function Body_Entity                         (Id : E) return E;
    function Body_Needed_For_SAL                 (Id : E) return B;
    function Body_References                     (Id : E) return L;
-   function BIP_Initialization_Call             (Id : E) return N;
-   function CR_Discriminant                     (Id : E) return E;
    function C_Pass_By_Copy                      (Id : E) return B;
    function Can_Never_Be_Null                   (Id : E) return B;
    function Can_Use_Internal_Rep                (Id : E) return B;
@@ -6655,12 +6664,9 @@ package Einfo is
    function Corresponding_Protected_Entry       (Id : E) return E;
    function Corresponding_Record_Type           (Id : E) return E;
    function Corresponding_Remote_Type           (Id : E) return E;
+   function CR_Discriminant                     (Id : E) return E;
    function Current_Use_Clause                  (Id : E) return E;
    function Current_Value                       (Id : E) return N;
-   function DTC_Entity                          (Id : E) return E;
-   function DT_Entry_Count                      (Id : E) return U;
-   function DT_Offset_To_Top_Func               (Id : E) return E;
-   function DT_Position                         (Id : E) return U;
    function Debug_Info_Off                      (Id : E) return B;
    function Debug_Renaming_Link                 (Id : E) return E;
    function Default_Aspect_Component_Value      (Id : E) return N;
@@ -6685,6 +6691,10 @@ package Einfo is
    function Discriminant_Default_Value          (Id : E) return N;
    function Discriminant_Number                 (Id : E) return U;
    function Dispatch_Table_Wrappers             (Id : E) return L;
+   function DT_Entry_Count                      (Id : E) return U;
+   function DT_Offset_To_Top_Func               (Id : E) return E;
+   function DT_Position                         (Id : E) return U;
+   function DTC_Entity                          (Id : E) return E;
    function Elaborate_Body_Desirable            (Id : E) return B;
    function Elaboration_Entity                  (Id : E) return E;
    function Elaboration_Entity_Required         (Id : E) return B;
@@ -6815,6 +6825,7 @@ package Einfo is
    function Has_Uplevel_Reference               (Id : E) return B;
    function Has_Visible_Refinement              (Id : E) return B;
    function Has_Volatile_Components             (Id : E) return B;
+   function Has_Volatile_Full_Access            (Id : E) return B;
    function Has_Xref_Entry                      (Id : E) return B;
    function Hiding_Loop_Variable                (Id : E) return E;
    function Homonym                             (Id : E) return E;
@@ -6836,7 +6847,6 @@ package Einfo is
    function Is_Asynchronous                     (Id : E) return B;
    function Is_Atomic                           (Id : E) return B;
    function Is_Bit_Packed_Array                 (Id : E) return B;
-   function Is_CPP_Class                        (Id : E) return B;
    function Is_Called                           (Id : E) return B;
    function Is_Character_Type                   (Id : E) return B;
    function Is_Checked_Ghost_Entity             (Id : E) return B;
@@ -6844,12 +6854,13 @@ package Einfo is
    function Is_Class_Wide_Equivalent_Type       (Id : E) return B;
    function Is_Compilation_Unit                 (Id : E) return B;
    function Is_Completely_Hidden                (Id : E) return B;
-   function Is_Constr_Subt_For_UN_Aliased       (Id : E) return B;
    function Is_Constr_Subt_For_U_Nominal        (Id : E) return B;
+   function Is_Constr_Subt_For_UN_Aliased       (Id : E) return B;
    function Is_Constrained                      (Id : E) return B;
    function Is_Constructor                      (Id : E) return B;
    function Is_Controlled                       (Id : E) return B;
    function Is_Controlling_Formal               (Id : E) return B;
+   function Is_CPP_Class                        (Id : E) return B;
    function Is_Default_Init_Cond_Procedure      (Id : E) return B;
    function Is_Descendent_Of_Address            (Id : E) return B;
    function Is_Discrim_SO_Function              (Id : E) return B;
@@ -6976,7 +6987,6 @@ package Einfo is
    function Original_Record_Component           (Id : E) return E;
    function Overlays_Constant                   (Id : E) return B;
    function Overridden_Operation                (Id : E) return E;
-   function PPC_Wrapper                         (Id : E) return E;
    function Package_Instantiation               (Id : E) return N;
    function Packed_Array_Impl_Type              (Id : E) return E;
    function Parent_Subtype                      (Id : E) return E;
@@ -6984,6 +6994,7 @@ package Einfo is
    function Partial_View_Has_Unknown_Discr      (Id : E) return B;
    function Pending_Access_Types                (Id : E) return L;
    function Postconditions_Proc                 (Id : E) return E;
+   function PPC_Wrapper                         (Id : E) return E;
    function Prival                              (Id : E) return E;
    function Prival_Link                         (Id : E) return E;
    function Private_Dependents                  (Id : E) return L;
@@ -6991,7 +7002,6 @@ package Einfo is
    function Protected_Body_Subprogram           (Id : E) return E;
    function Protected_Formal                    (Id : E) return E;
    function Protection_Object                   (Id : E) return E;
-   function RM_Size                             (Id : E) return U;
    function Reachable                           (Id : E) return B;
    function Referenced                          (Id : E) return B;
    function Referenced_As_LHS                   (Id : E) return B;
@@ -7014,6 +7024,7 @@ package Einfo is
    function Returns_Limited_View                (Id : E) return B;
    function Reverse_Bit_Order                   (Id : E) return B;
    function Reverse_Storage_Order               (Id : E) return B;
+   function RM_Size                             (Id : E) return U;
    function Scalar_Range                        (Id : E) return N;
    function Scale_Value                         (Id : E) return U;
    function Scope_Depth_Value                   (Id : E) return U;
@@ -7031,9 +7042,9 @@ package Einfo is
    function Spec_Entity                         (Id : E) return E;
    function SSO_Set_High_By_Default             (Id : E) return B;
    function SSO_Set_Low_By_Default              (Id : E) return B;
+   function Static_Discrete_Predicate           (Id : E) return S;
    function Static_Elaboration_Desired          (Id : E) return B;
    function Static_Initialization               (Id : E) return N;
-   function Static_Discrete_Predicate           (Id : E) return S;
    function Static_Real_Or_String_Predicate     (Id : E) return N;
    function Status_Flag_Or_Transient_Decl       (Id : E) return E;
    function Storage_Size_Variable               (Id : E) return E;
@@ -7282,12 +7293,11 @@ package Einfo is
    procedure Set_Associated_Node_For_Itype       (Id : E; V : N);
    procedure Set_Associated_Storage_Pool         (Id : E; V : E);
    procedure Set_Barrier_Function                (Id : E; V : N);
+   procedure Set_BIP_Initialization_Call         (Id : E; V : N);
    procedure Set_Block_Node                      (Id : E; V : N);
    procedure Set_Body_Entity                     (Id : E; V : E);
    procedure Set_Body_Needed_For_SAL             (Id : E; V : B := True);
    procedure Set_Body_References                 (Id : E; V : L);
-   procedure Set_BIP_Initialization_Call         (Id : E; V : N);
-   procedure Set_CR_Discriminant                 (Id : E; V : E);
    procedure Set_C_Pass_By_Copy                  (Id : E; V : B := True);
    procedure Set_Can_Never_Be_Null               (Id : E; V : B := True);
    procedure Set_Can_Use_Internal_Rep            (Id : E; V : B := True);
@@ -7307,12 +7317,9 @@ package Einfo is
    procedure Set_Corresponding_Protected_Entry   (Id : E; V : E);
    procedure Set_Corresponding_Record_Type       (Id : E; V : E);
    procedure Set_Corresponding_Remote_Type       (Id : E; V : E);
+   procedure Set_CR_Discriminant                 (Id : E; V : E);
    procedure Set_Current_Use_Clause              (Id : E; V : E);
    procedure Set_Current_Value                   (Id : E; V : N);
-   procedure Set_DTC_Entity                      (Id : E; V : E);
-   procedure Set_DT_Entry_Count                  (Id : E; V : U);
-   procedure Set_DT_Offset_To_Top_Func           (Id : E; V : E);
-   procedure Set_DT_Position                     (Id : E; V : U);
    procedure Set_Debug_Info_Off                  (Id : E; V : B := True);
    procedure Set_Debug_Renaming_Link             (Id : E; V : E);
    procedure Set_Default_Aspect_Component_Value  (Id : E; V : N);
@@ -7337,6 +7344,10 @@ package Einfo is
    procedure Set_Discriminant_Default_Value      (Id : E; V : N);
    procedure Set_Discriminant_Number             (Id : E; V : U);
    procedure Set_Dispatch_Table_Wrappers         (Id : E; V : L);
+   procedure Set_DT_Entry_Count                  (Id : E; V : U);
+   procedure Set_DT_Offset_To_Top_Func           (Id : E; V : E);
+   procedure Set_DT_Position                     (Id : E; V : U);
+   procedure Set_DTC_Entity                      (Id : E; V : E);
    procedure Set_Elaborate_Body_Desirable        (Id : E; V : B := True);
    procedure Set_Elaboration_Entity              (Id : E; V : E);
    procedure Set_Elaboration_Entity_Required     (Id : E; V : B := True);
@@ -7465,6 +7476,7 @@ package Einfo is
    procedure Set_Has_Uplevel_Reference           (Id : E; V : B := True);
    procedure Set_Has_Visible_Refinement          (Id : E; V : B := True);
    procedure Set_Has_Volatile_Components         (Id : E; V : B := True);
+   procedure Set_Has_Volatile_Full_Access        (Id : E; V : B := True);
    procedure Set_Has_Xref_Entry                  (Id : E; V : B := True);
    procedure Set_Hiding_Loop_Variable            (Id : E; V : E);
    procedure Set_Homonym                         (Id : E; V : E);
@@ -7486,7 +7498,6 @@ package Einfo is
    procedure Set_Is_Asynchronous                 (Id : E; V : B := True);
    procedure Set_Is_Atomic                       (Id : E; V : B := True);
    procedure Set_Is_Bit_Packed_Array             (Id : E; V : B := True);
-   procedure Set_Is_CPP_Class                    (Id : E; V : B := True);
    procedure Set_Is_Called                       (Id : E; V : B := True);
    procedure Set_Is_Character_Type               (Id : E; V : B := True);
    procedure Set_Is_Checked_Ghost_Entity         (Id : E; V : B := True);
@@ -7495,12 +7506,13 @@ package Einfo is
    procedure Set_Is_Compilation_Unit             (Id : E; V : B := True);
    procedure Set_Is_Completely_Hidden            (Id : E; V : B := True);
    procedure Set_Is_Concurrent_Record_Type       (Id : E; V : B := True);
-   procedure Set_Is_Constr_Subt_For_UN_Aliased   (Id : E; V : B := True);
    procedure Set_Is_Constr_Subt_For_U_Nominal    (Id : E; V : B := True);
+   procedure Set_Is_Constr_Subt_For_UN_Aliased   (Id : E; V : B := True);
    procedure Set_Is_Constrained                  (Id : E; V : B := True);
    procedure Set_Is_Constructor                  (Id : E; V : B := True);
    procedure Set_Is_Controlled                   (Id : E; V : B := True);
    procedure Set_Is_Controlling_Formal           (Id : E; V : B := True);
+   procedure Set_Is_CPP_Class                    (Id : E; V : B := True);
    procedure Set_Is_Default_Init_Cond_Procedure  (Id : E; V : B := True);
    procedure Set_Is_Descendent_Of_Address        (Id : E; V : B := True);
    procedure Set_Is_Discrim_SO_Function          (Id : E; V : B := True);
@@ -7632,7 +7644,6 @@ package Einfo is
    procedure Set_Original_Record_Component       (Id : E; V : E);
    procedure Set_Overlays_Constant               (Id : E; V : B := True);
    procedure Set_Overridden_Operation            (Id : E; V : E);
-   procedure Set_PPC_Wrapper                     (Id : E; V : E);
    procedure Set_Package_Instantiation           (Id : E; V : N);
    procedure Set_Packed_Array_Impl_Type          (Id : E; V : E);
    procedure Set_Parent_Subtype                  (Id : E; V : E);
@@ -7640,6 +7651,7 @@ package Einfo is
    procedure Set_Partial_View_Has_Unknown_Discr  (Id : E; V : B := True);
    procedure Set_Pending_Access_Types            (Id : E; V : L);
    procedure Set_Postconditions_Proc             (Id : E; V : E);
+   procedure Set_PPC_Wrapper                     (Id : E; V : E);
    procedure Set_Prival                          (Id : E; V : E);
    procedure Set_Prival_Link                     (Id : E; V : E);
    procedure Set_Private_Dependents              (Id : E; V : L);
@@ -7647,7 +7659,6 @@ package Einfo is
    procedure Set_Protected_Body_Subprogram       (Id : E; V : E);
    procedure Set_Protected_Formal                (Id : E; V : E);
    procedure Set_Protection_Object               (Id : E; V : E);
-   procedure Set_RM_Size                         (Id : E; V : U);
    procedure Set_Reachable                       (Id : E; V : B := True);
    procedure Set_Referenced                      (Id : E; V : B := True);
    procedure Set_Referenced_As_LHS               (Id : E; V : B := True);
@@ -7670,6 +7681,7 @@ package Einfo is
    procedure Set_Returns_Limited_View            (Id : E; V : B := True);
    procedure Set_Reverse_Bit_Order               (Id : E; V : B := True);
    procedure Set_Reverse_Storage_Order           (Id : E; V : B := True);
+   procedure Set_RM_Size                         (Id : E; V : U);
    procedure Set_Scalar_Range                    (Id : E; V : N);
    procedure Set_Scale_Value                     (Id : E; V : U);
    procedure Set_Scope_Depth_Value               (Id : E; V : U);
@@ -7687,9 +7699,9 @@ package Einfo is
    procedure Set_Spec_Entity                     (Id : E; V : E);
    procedure Set_SSO_Set_High_By_Default         (Id : E; V : B := True);
    procedure Set_SSO_Set_Low_By_Default          (Id : E; V : B := True);
+   procedure Set_Static_Discrete_Predicate       (Id : E; V : S);
    procedure Set_Static_Elaboration_Desired      (Id : E; V : B);
    procedure Set_Static_Initialization           (Id : E; V : N);
-   procedure Set_Static_Discrete_Predicate       (Id : E; V : S);
    procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N);
    procedure Set_Status_Flag_Or_Transient_Decl   (Id : E; V : E);
    procedure Set_Storage_Size_Variable           (Id : E; V : E);
@@ -8055,12 +8067,11 @@ package Einfo is
    pragma Inline (Associated_Node_For_Itype);
    pragma Inline (Associated_Storage_Pool);
    pragma Inline (Barrier_Function);
+   pragma Inline (BIP_Initialization_Call);
    pragma Inline (Block_Node);
    pragma Inline (Body_Entity);
    pragma Inline (Body_Needed_For_SAL);
    pragma Inline (Body_References);
-   pragma Inline (BIP_Initialization_Call);
-   pragma Inline (CR_Discriminant);
    pragma Inline (C_Pass_By_Copy);
    pragma Inline (Can_Never_Be_Null);
    pragma Inline (Can_Use_Internal_Rep);
@@ -8079,12 +8090,9 @@ package Einfo is
    pragma Inline (Corresponding_Protected_Entry);
    pragma Inline (Corresponding_Record_Type);
    pragma Inline (Corresponding_Remote_Type);
+   pragma Inline (CR_Discriminant);
    pragma Inline (Current_Use_Clause);
    pragma Inline (Current_Value);
-   pragma Inline (DTC_Entity);
-   pragma Inline (DT_Entry_Count);
-   pragma Inline (DT_Offset_To_Top_Func);
-   pragma Inline (DT_Position);
    pragma Inline (Debug_Info_Off);
    pragma Inline (Debug_Renaming_Link);
    pragma Inline (Default_Aspect_Component_Value);
@@ -8109,6 +8117,10 @@ package Einfo is
    pragma Inline (Discriminant_Default_Value);
    pragma Inline (Discriminant_Number);
    pragma Inline (Dispatch_Table_Wrappers);
+   pragma Inline (DT_Entry_Count);
+   pragma Inline (DT_Offset_To_Top_Func);
+   pragma Inline (DT_Position);
+   pragma Inline (DTC_Entity);
    pragma Inline (Elaborate_Body_Desirable);
    pragma Inline (Elaboration_Entity);
    pragma Inline (Elaboration_Entity_Required);
@@ -8236,6 +8248,7 @@ package Einfo is
    pragma Inline (Has_Uplevel_Reference);
    pragma Inline (Has_Visible_Refinement);
    pragma Inline (Has_Volatile_Components);
+   pragma Inline (Has_Volatile_Full_Access);
    pragma Inline (Has_Xref_Entry);
    pragma Inline (Hiding_Loop_Variable);
    pragma Inline (Homonym);
@@ -8262,7 +8275,6 @@ package Einfo is
    pragma Inline (Is_Asynchronous);
    pragma Inline (Is_Atomic);
    pragma Inline (Is_Bit_Packed_Array);
-   pragma Inline (Is_CPP_Class);
    pragma Inline (Is_Called);
    pragma Inline (Is_Character_Type);
    pragma Inline (Is_Checked_Ghost_Entity);
@@ -8275,12 +8287,13 @@ package Einfo is
    pragma Inline (Is_Concurrent_Body);
    pragma Inline (Is_Concurrent_Record_Type);
    pragma Inline (Is_Concurrent_Type);
-   pragma Inline (Is_Constr_Subt_For_UN_Aliased);
    pragma Inline (Is_Constr_Subt_For_U_Nominal);
+   pragma Inline (Is_Constr_Subt_For_UN_Aliased);
    pragma Inline (Is_Constrained);
    pragma Inline (Is_Constructor);
    pragma Inline (Is_Controlled);
    pragma Inline (Is_Controlling_Formal);
+   pragma Inline (Is_CPP_Class);
    pragma Inline (Is_Decimal_Fixed_Point_Type);
    pragma Inline (Is_Default_Init_Cond_Procedure);
    pragma Inline (Is_Descendent_Of_Address);
@@ -8444,7 +8457,6 @@ package Einfo is
    pragma Inline (Original_Record_Component);
    pragma Inline (Overlays_Constant);
    pragma Inline (Overridden_Operation);
-   pragma Inline (PPC_Wrapper);
    pragma Inline (Package_Instantiation);
    pragma Inline (Packed_Array_Impl_Type);
    pragma Inline (Parameter_Mode);
@@ -8453,6 +8465,7 @@ package Einfo is
    pragma Inline (Partial_View_Has_Unknown_Discr);
    pragma Inline (Pending_Access_Types);
    pragma Inline (Postconditions_Proc);
+   pragma Inline (PPC_Wrapper);
    pragma Inline (Prival);
    pragma Inline (Prival_Link);
    pragma Inline (Private_Dependents);
@@ -8460,7 +8473,6 @@ package Einfo is
    pragma Inline (Protected_Body_Subprogram);
    pragma Inline (Protected_Formal);
    pragma Inline (Protection_Object);
-   pragma Inline (RM_Size);
    pragma Inline (Reachable);
    pragma Inline (Referenced);
    pragma Inline (Referenced_As_LHS);
@@ -8483,6 +8495,7 @@ package Einfo is
    pragma Inline (Returns_Limited_View);
    pragma Inline (Reverse_Bit_Order);
    pragma Inline (Reverse_Storage_Order);
+   pragma Inline (RM_Size);
    pragma Inline (Scalar_Range);
    pragma Inline (Scale_Value);
    pragma Inline (Scope_Depth_Value);
@@ -8500,9 +8513,9 @@ package Einfo is
    pragma Inline (Spec_Entity);
    pragma Inline (SSO_Set_High_By_Default);
    pragma Inline (SSO_Set_Low_By_Default);
+   pragma Inline (Static_Discrete_Predicate);
    pragma Inline (Static_Elaboration_Desired);
    pragma Inline (Static_Initialization);
-   pragma Inline (Static_Discrete_Predicate);
    pragma Inline (Static_Real_Or_String_Predicate);
    pragma Inline (Status_Flag_Or_Transient_Decl);
    pragma Inline (Storage_Size_Variable);
@@ -8554,12 +8567,11 @@ package Einfo is
    pragma Inline (Set_Associated_Node_For_Itype);
    pragma Inline (Set_Associated_Storage_Pool);
    pragma Inline (Set_Barrier_Function);
+   pragma Inline (Set_BIP_Initialization_Call);
    pragma Inline (Set_Block_Node);
    pragma Inline (Set_Body_Entity);
    pragma Inline (Set_Body_Needed_For_SAL);
    pragma Inline (Set_Body_References);
-   pragma Inline (Set_BIP_Initialization_Call);
-   pragma Inline (Set_CR_Discriminant);
    pragma Inline (Set_C_Pass_By_Copy);
    pragma Inline (Set_Can_Never_Be_Null);
    pragma Inline (Set_Can_Use_Internal_Rep);
@@ -8578,12 +8590,9 @@ package Einfo is
    pragma Inline (Set_Corresponding_Protected_Entry);
    pragma Inline (Set_Corresponding_Record_Type);
    pragma Inline (Set_Corresponding_Remote_Type);
+   pragma Inline (Set_CR_Discriminant);
    pragma Inline (Set_Current_Use_Clause);
    pragma Inline (Set_Current_Value);
-   pragma Inline (Set_DTC_Entity);
-   pragma Inline (Set_DT_Entry_Count);
-   pragma Inline (Set_DT_Offset_To_Top_Func);
-   pragma Inline (Set_DT_Position);
    pragma Inline (Set_Debug_Info_Off);
    pragma Inline (Set_Debug_Renaming_Link);
    pragma Inline (Set_Default_Aspect_Component_Value);
@@ -8608,6 +8617,10 @@ package Einfo is
    pragma Inline (Set_Discriminant_Default_Value);
    pragma Inline (Set_Discriminant_Number);
    pragma Inline (Set_Dispatch_Table_Wrappers);
+   pragma Inline (Set_DT_Entry_Count);
+   pragma Inline (Set_DT_Offset_To_Top_Func);
+   pragma Inline (Set_DT_Position);
+   pragma Inline (Set_DTC_Entity);
    pragma Inline (Set_Elaborate_Body_Desirable);
    pragma Inline (Set_Elaboration_Entity);
    pragma Inline (Set_Elaboration_Entity_Required);
@@ -8732,6 +8745,7 @@ package Einfo is
    pragma Inline (Set_Has_Unknown_Discriminants);
    pragma Inline (Set_Has_Visible_Refinement);
    pragma Inline (Set_Has_Volatile_Components);
+   pragma Inline (Set_Has_Volatile_Full_Access);
    pragma Inline (Set_Has_Xref_Entry);
    pragma Inline (Set_Hiding_Loop_Variable);
    pragma Inline (Set_Homonym);
@@ -8752,7 +8766,6 @@ package Einfo is
    pragma Inline (Set_Is_Asynchronous);
    pragma Inline (Set_Is_Atomic);
    pragma Inline (Set_Is_Bit_Packed_Array);
-   pragma Inline (Set_Is_CPP_Class);
    pragma Inline (Set_Is_Called);
    pragma Inline (Set_Is_Character_Type);
    pragma Inline (Set_Is_Checked_Ghost_Entity);
@@ -8761,12 +8774,13 @@ package Einfo is
    pragma Inline (Set_Is_Compilation_Unit);
    pragma Inline (Set_Is_Completely_Hidden);
    pragma Inline (Set_Is_Concurrent_Record_Type);
-   pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);
    pragma Inline (Set_Is_Constr_Subt_For_U_Nominal);
+   pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);
    pragma Inline (Set_Is_Constrained);
    pragma Inline (Set_Is_Constructor);
    pragma Inline (Set_Is_Controlled);
    pragma Inline (Set_Is_Controlling_Formal);
+   pragma Inline (Set_Is_CPP_Class);
    pragma Inline (Set_Is_Default_Init_Cond_Procedure);
    pragma Inline (Set_Is_Descendent_Of_Address);
    pragma Inline (Set_Is_Discrim_SO_Function);
@@ -8898,7 +8912,6 @@ package Einfo is
    pragma Inline (Set_Original_Record_Component);
    pragma Inline (Set_Overlays_Constant);
    pragma Inline (Set_Overridden_Operation);
-   pragma Inline (Set_PPC_Wrapper);
    pragma Inline (Set_Package_Instantiation);
    pragma Inline (Set_Packed_Array_Impl_Type);
    pragma Inline (Set_Parent_Subtype);
@@ -8906,6 +8919,7 @@ package Einfo is
    pragma Inline (Set_Partial_View_Has_Unknown_Discr);
    pragma Inline (Set_Pending_Access_Types);
    pragma Inline (Set_Postconditions_Proc);
+   pragma Inline (Set_PPC_Wrapper);
    pragma Inline (Set_Prival);
    pragma Inline (Set_Prival_Link);
    pragma Inline (Set_Private_Dependents);
@@ -8913,7 +8927,6 @@ package Einfo is
    pragma Inline (Set_Protected_Body_Subprogram);
    pragma Inline (Set_Protected_Formal);
    pragma Inline (Set_Protection_Object);
-   pragma Inline (Set_RM_Size);
    pragma Inline (Set_Reachable);
    pragma Inline (Set_Referenced);
    pragma Inline (Set_Referenced_As_LHS);
@@ -8936,6 +8949,7 @@ package Einfo is
    pragma Inline (Set_Returns_Limited_View);
    pragma Inline (Set_Reverse_Bit_Order);
    pragma Inline (Set_Reverse_Storage_Order);
+   pragma Inline (Set_RM_Size);
    pragma Inline (Set_Scalar_Range);
    pragma Inline (Set_Scale_Value);
    pragma Inline (Set_Scope_Depth_Value);
@@ -8953,9 +8967,9 @@ package Einfo is
    pragma Inline (Set_Spec_Entity);
    pragma Inline (Set_SSO_Set_High_By_Default);
    pragma Inline (Set_SSO_Set_Low_By_Default);
+   pragma Inline (Set_Static_Discrete_Predicate);
    pragma Inline (Set_Static_Elaboration_Desired);
    pragma Inline (Set_Static_Initialization);
-   pragma Inline (Set_Static_Discrete_Predicate);
    pragma Inline (Set_Static_Real_Or_String_Predicate);
    pragma Inline (Set_Status_Flag_Or_Transient_Decl);
    pragma Inline (Set_Storage_Size_Variable);

diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index ec8df4a..825929a 100644 (file)
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1487,6 +1487,7 @@ begin
            Pragma_Use_VADS_Size                  |
            Pragma_Volatile                       |
            Pragma_Volatile_Components            |
+           Pragma_Volatile_Full_Access           |
            Pragma_Warning_As_Error               |
            Pragma_Weak_External                  |
            Pragma_Validity_Checks                =>

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 63d2cb7..97933bb 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1713,6 +1713,16 @@ package body Sem_Ch10 is
                return;
             end if;
 
+            --  Collect SCO information for loaded subunit if we are in the
+            --  extended main unit.
+
+            if Generate_SCO
+              and then In_Extended_Main_Source_Unit
+                         (Cunit_Entity (Current_Sem_Unit))
+            then
+               SCO_Record_Raw (Get_Cunit_Unit_Number (Library_Unit (N)));
+            end if;
+
             Analyze_Subunit (Library_Unit (N));
 
          --  Otherwise we must load the subunit and link to it
@@ -1873,7 +1883,7 @@ package body Sem_Ch10 is
                   Version_Update (Cunit (Main_Unit), Comp_Unit);
 
                   --  Collect SCO information for loaded subunit if we are in
-                  --  the main unit.
+                  --  the extended main unit.
 
                   if Generate_SCO
                     and then

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index cac9db9..fca3856 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11698,6 +11698,14 @@ package body Sem_Ch12 is
                  Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
             end if;
 
+         --  Check whether parent is a previous formal of the current generic
+
+         elsif Is_Derived_Type (A_Gen_T)
+           and then Is_Generic_Type (Etype (A_Gen_T))
+           and then Scope (A_Gen_T) = Scope (Etype (A_Gen_T))
+         then
+            Ancestor := Get_Instance_Of (First_Subtype (Etype (A_Gen_T)));
+
          --  An unusual case: the actual is a type declared in a parent unit,
          --  but is not a formal type so there is no instance_of for it.
          --  Retrieve it by analyzing the record extension.
@@ -11733,6 +11741,9 @@ package body Sem_Ch12 is
                   Actual, Ancestor);
             end if;
 
+         --  Finally verify that the (instance of) the ancestor is an ancestor
+         --  of the actual.
+
          elsif not Is_Ancestor (Base_Type (Ancestor), Act_T) then
             Error_Msg_NE
               ("expect type derived from & in instantiation",

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 42fb1dd..001365b 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9882,6 +9882,7 @@ package body Sem_Ch6 is
      (T           : List_Id;
       Related_Nod : Node_Id)
    is
+      Context     : constant Node_Id := Parent (Parent (T));
       Param_Spec  : Node_Id;
       Formal      : Entity_Id;
       Formal_Type : Entity_Id;
@@ -10027,6 +10028,8 @@ package body Sem_Ch6 is
 
                   --  Incomplete formal untagged types are not allowed in
                   --  subprogram bodies (but are legal in their declarations).
+                  --  This excludes bodies created for null procedures, which
+                  --  are basic declarations.
 
                   if Is_Generic_Type (Formal_Type)
                     and then not Is_Tagged_Type (Formal_Type)
@@ -10042,13 +10045,14 @@ package body Sem_Ch6 is
                      then
                         null;
 
-                     elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement,
-                                                          N_Accept_Alternative,
-                                                          N_Entry_Body,
-                                                          N_Subprogram_Body)
+                     elsif Nkind_In (Context, N_Accept_Statement,
+                                              N_Accept_Alternative,
+                                              N_Entry_Body)
+                       or else (Nkind (Context) = N_Subprogram_Body
+                                 and then Comes_From_Source (Context))
                      then
                         Error_Msg_NE
-                          ("invalid use of untagged incomplete type&",
+                          ("invalid use of untagged incomplete type &",
                            Ptype, Formal_Type);
                      end if;
 

diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 227469a..9e514c1 100644 (file)
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -619,6 +619,18 @@ package body Sem_Elab is
          return;
       end if;
 
+      --  If this is a rewrite of a Valid_Scalars attribute, then nothing to
+      --  check, we don't mind in this case if the call occurs before the body
+      --  since this is all generated code.
+
+      if Nkind (Original_Node (N)) = N_Attribute_Reference
+        and then Attribute_Name (Original_Node (N)) = Name_Valid_Scalars
+      then
+         return;
+      end if;
+
+      --  Proceed with check
+
       Ent := E;
 
       --  For a variable reference, just set Body_Acts_As_Spec to False

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 758aed0..8e3cd4c 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3058,9 +3058,9 @@ package body Sem_Prag is
       --  Issue fatal error message for misplaced pragma
 
       procedure Process_Atomic_Independent_Shared_Volatile;
-      --  Common processing for pragmas Atomic, Independent, Shared, Volatile.
-      --  Note that Shared is an obsolete Ada 83 pragma and treated as being
-      --  identical in effect to pragma Atomic.
+      --  Common processing for pragmas Atomic, Independent, Shared, Volatile,
+      --  Volatile_Full_Access. Note that Shared is an obsolete Ada 83 pragma
+      --  and treated as being identical in effect to pragma Atomic.
 
       procedure Process_Compile_Time_Warning_Or_Error;
       --  Common processing for Compile_Time_Error and Compile_Time_Warning
@@ -5822,24 +5822,28 @@ package body Sem_Prag is
          K    : Node_Kind;
          Utyp : Entity_Id;
 
-         procedure Set_Atomic (E : Entity_Id);
-         --  Set given type as atomic, and if no explicit alignment was given,
-         --  set alignment to unknown, since back end knows what the alignment
-         --  requirements are for atomic arrays. Note: this step is necessary
-         --  for derived types.
+         procedure Set_Atomic_Full (E : Entity_Id);
+         --  Set given type as Is_Atomic or Has_Volatile_Full_Access. Also, if
+         --  no explicit alignment was given, set alignment to unknown, since
+         --  back end knows what the alignment requirements are for atomic and
+         --  full access arrays. Note: this is necessary for derived types.
 
-         ----------------
-         -- Set_Atomic --
-         ----------------
+         ---------------------
+         -- Set_Atomic_Full --
+         ---------------------
 
-         procedure Set_Atomic (E : Entity_Id) is
+         procedure Set_Atomic_Full (E : Entity_Id) is
          begin
-            Set_Is_Atomic (E);
+            if Prag_Id = Pragma_Volatile_Full_Access then
+               Set_Has_Volatile_Full_Access (E);
+            else
+               Set_Is_Atomic (E);
+            end if;
 
             if not Has_Alignment_Clause (E) then
                Set_Alignment (E, Uint_0);
             end if;
-         end Set_Atomic;
+         end Set_Atomic_Full;
 
       --  Start of processing for Process_Atomic_Independent_Shared_Volatile
 
@@ -5874,13 +5878,18 @@ package body Sem_Prag is
                Check_First_Subtype (Arg1);
             end if;
 
-            if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared then
-               Set_Atomic (E);
-               Set_Atomic (Underlying_Type (E));
-               Set_Atomic (Base_Type (E));
+            if Prag_Id = Pragma_Atomic
+                 or else
+               Prag_Id = Pragma_Shared
+                 or else
+               Prag_Id = Pragma_Volatile_Full_Access
+            then
+               Set_Atomic_Full (E);
+               Set_Atomic_Full (Underlying_Type (E));
+               Set_Atomic_Full (Base_Type (E));
             end if;
 
-            --  Atomic/Shared imply both Independent and Volatile
+            --  Atomic/Shared/Volatile_Full_Access imply Independent
 
             if Prag_Id /= Pragma_Volatile then
                Set_Is_Independent (E);
@@ -5896,6 +5905,11 @@ package body Sem_Prag is
             --  currently private, it also belongs on the underlying type.
 
             if Prag_Id /= Pragma_Independent then
+               if Prag_Id = Pragma_Volatile_Full_Access then
+                  Set_Has_Volatile_Full_Access (Base_Type (E));
+                  Set_Has_Volatile_Full_Access (Underlying_Type (E));
+               end if;
+
                Set_Is_Volatile (Base_Type (E));
                Set_Is_Volatile (Underlying_Type (E));
 
@@ -5911,8 +5925,17 @@ package body Sem_Prag is
                return;
             end if;
 
-            if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared then
-               Set_Is_Atomic (E);
+            if Prag_Id = Pragma_Atomic
+                 or else
+               Prag_Id = Pragma_Shared
+                 or else
+               Prag_Id = Pragma_Volatile_Full_Access
+            then
+               if Prag_Id = Pragma_Volatile_Full_Access then
+                  Set_Has_Volatile_Full_Access (E);
+               else
+                  Set_Is_Atomic (E);
+               end if;
 
                --  If the object declaration has an explicit initialization, a
                --  temporary may have to be created to hold the expression, to
@@ -5939,6 +5962,9 @@ package body Sem_Prag is
                --  treated as atomic, thus incurring a potentially costly
                --  synchronization operation for every access.
 
+               --  For Volatile_Full_Access we can do this for elementary
+               --  types too, since there is no issue of atomic sync.
+
                --  Of course it would be best if the back end could just adjust
                --  the alignment etc for the specific object, but that's not
                --  something we are capable of doing at this point.
@@ -5946,14 +5972,21 @@ package body Sem_Prag is
                Utyp := Underlying_Type (Etype (E));
 
                if Present (Utyp)
-                 and then Is_Composite_Type (Utyp)
+                 and then (Is_Composite_Type (Utyp)
+                            or else Prag_Id = Pragma_Volatile_Full_Access)
                  and then Sloc (E) > No_Location
                  and then Sloc (Utyp) > No_Location
                  and then
                    Get_Source_File_Index (Sloc (E)) =
                    Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
                then
-                  Set_Is_Atomic (Underlying_Type (Etype (E)));
+                  if Prag_Id = Pragma_Volatile_Full_Access then
+                     Set_Has_Volatile_Full_Access
+                       (Underlying_Type (Etype (E)));
+                  else
+                     Set_Is_Atomic
+                       (Underlying_Type (Etype (E)));
+                  end if;
                end if;
             end if;
 
@@ -21220,7 +21253,17 @@ package body Sem_Prag is
          when Pragma_Volatile =>
             Process_Atomic_Independent_Shared_Volatile;
 
-         -------------------------
+         --------------------------
+         -- Volatile_Full_Access --
+         --------------------------
+
+         --  pragma Volatile_Full_Access (LOCAL_NAME);
+
+         when Pragma_Volatile_Full_Access =>
+            GNAT_Pragma;
+            Process_Atomic_Independent_Shared_Volatile;
+
+            -------------------------
          -- Volatile_Components --
          -------------------------
 
@@ -26148,6 +26191,7 @@ package body Sem_Prag is
       Pragma_Validity_Checks                =>  0,
       Pragma_Volatile                       =>  0,
       Pragma_Volatile_Components            =>  0,
+      Pragma_Volatile_Full_Access           =>  0,
       Pragma_Warning_As_Error               =>  0,
       Pragma_Warnings                       =>  0,
       Pragma_Weak_External                  =>  0,

diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 534d0d0..6dc7c00 100644 (file)
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -632,6 +632,7 @@ package Snames is
    Name_Unreserve_All_Interrupts       : constant Name_Id := N + $; -- GNAT
    Name_Volatile                       : constant Name_Id := N + $;
    Name_Volatile_Components            : constant Name_Id := N + $;
+   Name_Volatile_Full_Access           : constant Name_Id := N + $; -- GNAT
    Name_Weak_External                  : constant Name_Id := N + $; -- GNAT
    Last_Pragma_Name                    : constant Name_Id := N + $;
 
@@ -1939,6 +1940,7 @@ package Snames is
       Pragma_Unreserve_All_Interrupts,
       Pragma_Volatile,
       Pragma_Volatile_Components,
+      Pragma_Volatile_Full_Access,
       Pragma_Weak_External,
 
       --  The following pragmas are on their own, out of order, because of the

diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads
index efb6e02..03dfb51 100644 (file)
--- a/gcc/ada/targparm.ads
+++ b/gcc/ada/targparm.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -362,13 +362,13 @@ package Targparm is
    ---------------------
 
    --  By default, type Duration is a 64-bit fixed-point type with a delta
-   --  and small of 10**(-9) (i.e. it is a count in nanoseconds. This flag
+   --  and small of 10**(-9) (i.e. it is a count in nanoseconds). This flag
    --  allows that standard format to be modified.
 
    Duration_32_Bits_On_Target : Boolean := False;
    --  If True, then Duration is represented in 32 bits and the delta and
    --  small values are set to 20.0*(10**(-3)) (i.e. it is a count in units
-   --  of 20 milliseconds.
+   --  of 20 milliseconds).
 
    ------------------------------------
    -- Back-End Code Generation Flags --