[multiple changes]

2017-01-23  Gary Dismukes  <dismukes@adacore.com>

	* a-calend.adb, prep.adb, debug.adb, prj.ads, prepcomp.adb,
	exp_disp.adb, s-imgrea.adb, g-socket.adb, g-socket.ads, sem_ch13.adb,
	prj-tree.ads: Minor spelling change for consistency (behaviour ->
	behavior).

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* scng.adb (Scan): Use Ada version Ada_2020 to flag use of
	Target_Name.
	* par-ch4.adb (P_Primary): Ditto.
	* opt.ads: Add Ada_2020 (optimistically) to enumeration list of
	Ada_Version_Type.
	* switch-c.adb (Scan_Front_End_Switches): Recognize -gnat2020 for
	new Ada version Ada_2020.

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Force the generation
	of a nominal type for the constant which captures the value of
	the attribute prefix. Various clean ups.
	* sem_attr.adb (Analyze_Attribute): Clean up the processing of
	'Loop_Entry.

2017-01-23  Yannick Moy  <moy@adacore.com>

	* sem_util.adb (Has_Enabled_Property): Treat
	protected objects and variables differently from other variables.

From-SVN: r244787

gcc/ada/ChangeLog

+2017-01-23  Yannick Moy  <moy@adacore.com>
+
+	* sem_util.adb (Has_Enabled_Property): Treat
+	protected objects and variables differently from other variables.
+
 2017-01-23  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order):

gcc/ada/a-calend.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --

gcc/ada/debug.adb

@@ -558,7 +558,7 @@ package body Debug is
    --  d.o  Conservative elaboration order for indirect calls. This causes
    --       P'Access to be treated as a call in more cases.
 
-   --  d.p  In Ada 95 (or 83) mode, use original Ada 95 behaviour for the
+   --  d.p  In Ada 95 (or 83) mode, use original Ada 95 behavior for the
    --       interpretation of component clauses crossing byte boundaries when
    --       using the non-default bit order (i.e. ignore AI95-0133).
 

gcc/ada/exp_attr.adb

@@ -1019,13 +1019,11 @@ package body Exp_Attr is
 
       --  Local variables
 
-      Exprs     : constant List_Id   := Expressions (N);
       Pref      : constant Node_Id   := Prefix (N);
-      Typ       : constant Entity_Id := Etype (Pref);
+      Base_Typ  : constant Entity_Id := Base_Type (Etype (Pref));
+      Exprs     : constant List_Id   := Expressions (N);
+      Aux_Decl  : Node_Id;
       Blk       : Node_Id;
-      CW_Decl   : Node_Id;
-      CW_Temp   : Entity_Id;
-      CW_Typ    : Entity_Id;
       Decls     : List_Id;
       Installed : Boolean;
       Loc       : Source_Ptr;
@@ -1048,10 +1046,10 @@ package body Exp_Attr is
          Loop_Id   := Entity (First (Exprs));
          Loop_Stmt := Label_Construct (Parent (Loop_Id));
 
-      --  Climb the parent chain to find the nearest enclosing loop. Skip all
-      --  internally generated loops for quantified expressions and for
-      --  element iterators over multidimensional arrays: pragma applies to
-      --  source loop.
+      --  Climb the parent chain to find the nearest enclosing loop. Skip
+      --  all internally generated loops for quantified expressions and for
+      --  element iterators over multidimensional arrays because the pragma
+      --  applies to source loop.
 
       else
          Loop_Stmt := N;
@@ -1350,49 +1348,68 @@ package body Exp_Attr is
       --  Preserve the tag of the prefix by offering a specific view of the
       --  class-wide version of the prefix.
 
-      if Is_Tagged_Type (Typ) then
+      if Is_Tagged_Type (Base_Typ) then
+         Tagged_Case : declare
+            CW_Temp : Entity_Id;
+            CW_Typ  : Entity_Id;
 
+         begin
             --  Generate:
-         --    CW_Temp : constant Typ'Class := Typ'Class (Pref);
+            --    CW_Temp : constant Base_Typ'Class := Base_Typ'Class (Pref);
 
             CW_Temp := Make_Temporary (Loc, 'T');
-         CW_Typ  := Class_Wide_Type (Typ);
+            CW_Typ  := Class_Wide_Type (Base_Typ);
 
-         CW_Decl :=
+            Aux_Decl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => CW_Temp,
                 Constant_Present    => True,
                 Object_Definition   => New_Occurrence_Of (CW_Typ, Loc),
                 Expression          =>
                   Convert_To (CW_Typ, Relocate_Node (Pref)));
-         Append_To (Decls, CW_Decl);
+            Append_To (Decls, Aux_Decl);
 
             --  Generate:
-         --    Temp : Typ renames Typ (CW_Temp);
+            --    Temp : Base_Typ renames Base_Typ (CW_Temp);
 
             Temp_Decl :=
               Make_Object_Renaming_Declaration (Loc,
                 Defining_Identifier => Temp_Id,
-             Subtype_Mark        => New_Occurrence_Of (Typ, Loc),
+                Subtype_Mark        => New_Occurrence_Of (Base_Typ, Loc),
                 Name                =>
-               Convert_To (Typ, New_Occurrence_Of (CW_Temp, Loc)));
+                  Convert_To (Base_Typ, New_Occurrence_Of (CW_Temp, Loc)));
             Append_To (Decls, Temp_Decl);
+         end Tagged_Case;
 
-      --  Non-tagged case
+      --  Untagged case
 
       else
-         CW_Decl := Empty;
+         Untagged_Case : declare
+            Temp_Expr : Node_Id;
+
+         begin
+            Aux_Decl := Empty;
+
+            --  Generate a nominal type for the constant when the prefix is of
+            --  a constrained type. This is achieved by setting the Etype of
+            --  the relocated prefix to its base type. Since the prefix is now
+            --  the initialization expression of the constant, its freezing
+            --  will produce a proper nominal type.
+
+            Temp_Expr := Relocate_Node (Pref);
+            Set_Etype (Temp_Expr, Base_Typ);
 
             --  Generate:
-         --    Temp : constant Typ := Pref;
+            --    Temp : constant Base_Typ := Pref;
 
             Temp_Decl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Temp_Id,
                 Constant_Present    => True,
-             Object_Definition   => New_Occurrence_Of (Typ, Loc),
-             Expression          => Relocate_Node (Pref));
+                Object_Definition   => New_Occurrence_Of (Base_Typ, Loc),
+                Expression          => Temp_Expr);
             Append_To (Decls, Temp_Decl);
+         end Untagged_Case;
       end if;
 
       --  Step 4: Analyze all bits
@@ -1418,8 +1435,8 @@ package body Exp_Attr is
       --  the declaration of the constant.
 
       else
-         if Present (CW_Decl) then
-            Analyze (CW_Decl);
+         if Present (Aux_Decl) then
+            Analyze (Aux_Decl);
          end if;
 
          Analyze (Temp_Decl);

gcc/ada/opt.ads

@@ -101,6 +101,11 @@ package Opt is
    --  GPRBUILD
    --  Set to True by gprbuild when the version of GNAT is 5.03 or before.
 
+   Checksum_Accumulate_Limited_Checksum : Boolean := False;
+   --  Used to control the computation of the limited view of a package.
+   --  (Not currently used, possible optimization for ALI files of units
+   --  in limited with_clauses).
+
    ----------------------------------------------
    -- Settings of Modes for Current Processing --
    ----------------------------------------------
@@ -117,7 +122,7 @@ package Opt is
    --  trying to specify other values will be ignored (in case of pragma
    --  Ada_xxx) or generate an error (in case of -gnat83/95/xx switches).
 
-   type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012);
+   type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2020);
    pragma Ordered (Ada_Version_Type);
    --  Versions of Ada for Ada_Version below. Note that these are ordered,
    --  so that tests like Ada_Version >= Ada_95 are legitimate and useful.

gcc/ada/par-ch4.adb

@@ -2798,7 +2798,7 @@ package body Ch4 is
                Scan; -- past minus
 
             when Tok_At_Sign =>    --  AI12-0125 : target_name
-               if not Extensions_Allowed then
+               if Ada_Version < Ada_2020 then
                   Error_Msg_SC ("target name is an Ada 2020 extension");
                   Error_Msg_SC ("\compile with -gnatX");
                end if;

gcc/ada/prepcomp.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2016, 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- --

gcc/ada/prj-tree.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2016, 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- --

gcc/ada/prj.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2016, 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- --

gcc/ada/s-imgrea.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --

gcc/ada/scng.adb

@@ -1612,7 +1612,7 @@ package body Scng is
             end if;
 
          when '@' =>
-            if not Extensions_Allowed then
+            if Ada_Version < Ada_2020 then
                Error_Illegal_Character;
                Scan_Ptr := Scan_Ptr + 1;
 

gcc/ada/sem_attr.adb

@@ -4297,11 +4297,11 @@ package body Sem_Attr is
 
          Context   : constant Node_Id := Parent (N);
          Attr      : Node_Id;
-         Enclosing_Loop    : Node_Id;
+         Encl_Loop : Node_Id;
+         Encl_Prag : Node_Id   := Empty;
          Loop_Id   : Entity_Id := Empty;
          Scop      : Entity_Id;
          Stmt      : Node_Id;
-         Enclosing_Pragma  : Node_Id   := Empty;
 
       --  Start of processing for Loop_Entry
 
@@ -4419,7 +4419,7 @@ package body Sem_Attr is
                                Name_Assert_And_Cut,
                                Name_Assume)
             then
-               Enclosing_Pragma := Original_Node (Stmt);
+               Encl_Prag := Original_Node (Stmt);
 
             --  Locate the enclosing loop (if any). Note that Ada 2012 array
             --  iteration may be expanded into several nested loops, we are
@@ -4431,14 +4431,14 @@ package body Sem_Attr is
               and then Comes_From_Source (Original_Node (Stmt))
               and then Nkind (Original_Node (Stmt)) = N_Loop_Statement
             then
-               Enclosing_Loop := Stmt;
+               Encl_Loop := Stmt;
 
                --  The original attribute reference may lack a loop name. Use
                --  the name of the enclosing loop because it is the related
                --  loop.
 
                if No (Loop_Id) then
-                  Loop_Id := Entity (Identifier (Enclosing_Loop));
+                  Loop_Id := Entity (Identifier (Encl_Loop));
                end if;
 
                exit;
@@ -4467,7 +4467,7 @@ package body Sem_Attr is
          then
             null;
 
-         elsif No (Enclosing_Pragma) then
+         elsif No (Encl_Prag) then
             Error_Attr ("attribute% must appear within appropriate pragma", N);
          end if;
 
@@ -4504,8 +4504,8 @@ package body Sem_Attr is
          then
             null;
 
-         elsif Present (Enclosing_Loop)
-           and then Entity (Identifier (Enclosing_Loop)) /= Loop_Id
+         elsif Present (Encl_Loop)
+           and then Entity (Identifier (Encl_Loop)) /= Loop_Id
          then
             Error_Attr_P
               ("prefix of attribute % that applies to outer loop must denote "
@@ -4521,9 +4521,7 @@ package body Sem_Attr is
          --  early transformation also avoids the generation of a useless loop
          --  entry constant.
 
-         if Present (Enclosing_Pragma)
-           and then Is_Ignored (Enclosing_Pragma)
-         then
+         if Present (Encl_Prag) and then Is_Ignored (Encl_Prag) then
             Rewrite (N, Relocate_Node (P));
             Preanalyze_And_Resolve (N);
 

gcc/ada/sem_ch13.adb

@@ -81,7 +81,7 @@ package body Sem_Ch13 is
    -----------------------
 
    procedure Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R : Entity_Id);
-   --  Helper routine providing the original (pre-AI95-0133) behaviour for
+   --  Helper routine providing the original (pre-AI95-0133) behavior for
    --  Adjust_Record_For_Reverse_Bit_Order.
 
    procedure Alignment_Check_For_Size_Change (Typ : Entity_Id; Size : Uint);
@@ -364,9 +364,9 @@ package body Sem_Ch13 is
       SSU    : constant Uint := UI_From_Int (System_Storage_Unit);
 
    begin
-      --  Processing here used to depend on Ada version: the behaviour was
+      --  Processing here used to depend on Ada version: the behavior was
       --  changed by AI95-0133. However this AI is a Binding interpretation,
-      --  so we now implement it even in Ada 95 mode. The original behaviour
+      --  so we now implement it even in Ada 95 mode. The original behavior
       --  from unamended Ada 95 is still available for compatibility under
       --  debugging switch -gnatd.
 

gcc/ada/sem_util.adb

@@ -9118,6 +9118,10 @@ package body Sem_Util is
      (Item_Id  : Entity_Id;
       Property : Name_Id) return Boolean
    is
+      function Protected_Object_Has_Enabled_Property return Boolean;
+      --  Determine whether a protected object denoted by Item_Id has the
+      --  property enabled.
+
       function State_Has_Enabled_Property return Boolean;
       --  Determine whether a state denoted by Item_Id has the property enabled
 
@@ -9125,6 +9129,44 @@ package body Sem_Util is
       --  Determine whether a variable denoted by Item_Id has the property
       --  enabled.
 
+      -------------------------------------------
+      -- Protected_Object_Has_Enabled_Property --
+      -------------------------------------------
+
+      function Protected_Object_Has_Enabled_Property return Boolean is
+         Constits     : constant Elist_Id := Part_Of_Constituents (Item_Id);
+         Constit_Elmt : Elmt_Id;
+         Constit_Id   : Entity_Id;
+
+      begin
+         --  Protected objects always have the properties Async_Readers and
+         --  Async_Writers. (SPARK RM 7.1.2(16))
+
+         if Property = Name_Async_Readers
+           or else Property = Name_Async_Writers
+         then
+            return True;
+
+         --  Protected objects that have Part_Of components also inherit
+         --  their properties Effective_Reads and Effective_Writes. (SPARK
+         --  RM 7.1.2(16))
+
+         elsif Present (Constits) then
+            Constit_Elmt := First_Elmt (Constits);
+            while Present (Constit_Elmt) loop
+               Constit_Id := Node (Constit_Elmt);
+
+               if Has_Enabled_Property (Constit_Id, Property) then
+                  return True;
+               end if;
+
+               Next_Elmt (Constit_Elmt);
+            end loop;
+         end if;
+
+         return False;
+      end Protected_Object_Has_Enabled_Property;
+
       --------------------------------
       -- State_Has_Enabled_Property --
       --------------------------------
@@ -9302,7 +9344,19 @@ package body Sem_Util is
          --  The implicit case lacks all property pragmas
 
          elsif No (AR) and then No (AW) and then No (ER) and then No (EW) then
+
+            --  A variable of a protected type only has the properties
+            --  Async_Readers and Async_Writers. It cannot have Part_Of
+            --  components (only protected objects can), hence it cannot
+            --  inherit their properties Effective_Reads and Effective_Writes.
+            --  (SPARK RM 7.1.2(16))
+
+            if Is_Protected_Type (Etype (Item_Id)) then
+               return Property = Name_Async_Readers
+                 or else Property = Name_Async_Writers;
+            else
                return True;
+            end if;
 
          else
             return False;
@@ -9321,6 +9375,14 @@ package body Sem_Util is
       elsif Ekind (Item_Id) = E_Variable then
          return Variable_Has_Enabled_Property;
 
+      --  By default, protected objects only have the properties Async_Readers
+      --  and Async_Writers. If they have Part_Of components, they also inherit
+      --  their properties Effective_Reads and Effective_Writes. (SPARK RM
+      --  7.1.2(16))
+
+      elsif Ekind (Item_Id) = E_Protected_Object then
+         return Protected_Object_Has_Enabled_Property;
+
       --  Otherwise a property is enabled when the related item is effectively
       --  volatile.
 

gcc/ada/switch-c.adb

@@ -1502,6 +1502,9 @@ package body Switch.C is
                elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
                   Ada_Version := Ada_2012;
 
+               elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then
+                  Ada_Version := Ada_2020;
+
                else
                   Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
                end if;