2014-01-22 Thomas Quinot <quinot@adacore.com>

	* rtsfind.adb: Update comment.

2014-01-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_aux.ads, sem_aux.adb (Is_Body): New routine.
	* sem_ch3.adb (Analyze_Declarations): Add local variable
	Body_Seen. Generate the spec of a late controlled
	primitive body that is about to freeze its related type.
	(Handle_Late_Controlled_Primitive): New routine.

2014-01-22  Robert Dewar  <dewar@adacore.com>

	* a-stream.adb: Minor reformatting.

2014-01-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (From_Actual_Package): Introduce a recursive
	sub-procedure Declared_In_Actual to handle properly the visibility
	of actuals in actual packages, that are themselves actuals to a
	actual package of the current instance. This mimics properly the
	visibility of formals of formal packages declared with a box,
	within the corresponding generic unit.

2014-01-22  Robert Dewar  <dewar@adacore.com>

	* checks.adb: Do not assume that a volatile variable is valid.

2014-01-22  Thomas Quinot  <quinot@adacore.com>

	* g-catiio.ads (Image, Value): Clarify that these functions
	operate in the local time zone.  Minor documentation update.

2014-01-22  Thomas Quinot  <quinot@adacore.com>

	* csets.adb, csets.ads, opt.ads: Minor documentation fixes.



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

12 files changed, 246 insertions, 63 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index eafe2bd30b4..e8c2d2d6537 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2014-01-22  Thomas Quinot  <quinot@adacore.com>
+
+	* rtsfind.adb: Update comment.
+
+2014-01-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_aux.ads, sem_aux.adb (Is_Body): New routine.
+	* sem_ch3.adb (Analyze_Declarations): Add local variable
+	Body_Seen. Generate the spec of a late controlled
+	primitive body that is about to freeze its related type.
+	(Handle_Late_Controlled_Primitive): New routine.
+
+2014-01-22  Robert Dewar  <dewar@adacore.com>
+
+	* a-stream.adb: Minor reformatting.
+
+2014-01-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (From_Actual_Package): Introduce a recursive
+	sub-procedure Declared_In_Actual to handle properly the visibility
+	of actuals in actual packages, that are themselves actuals to a
+	actual package of the current instance. This mimics properly the
+	visibility of formals of formal packages declared with a box,
+	within the corresponding generic unit.
+
+2014-01-22  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb: Do not assume that a volatile variable is valid.
+
+2014-01-22  Thomas Quinot  <quinot@adacore.com>
+
+	* g-catiio.ads (Image, Value): Clarify that these functions
+	operate in the local time zone.  Minor documentation update.
+
+2014-01-22  Thomas Quinot  <quinot@adacore.com>
+
+	* csets.adb, csets.ads, opt.ads: Minor documentation fixes.
+
 2014-01-22  Robert Dewar  <dewar@adacore.com>
 
 	* sem_aux.adb, sem_aux.ads, sem_ch3.adb (Has_Unconstrained_Elements):
diff --git a/gcc/ada/a-stream.adb b/gcc/ada/a-stream.adb
index 59f0a3ddbdb..a22161d16da 100644
--- a/gcc/ada/a-stream.adb
+++ b/gcc/ada/a-stream.adb
@@ -46,8 +46,10 @@ package body Ada.Streams is
       V : out Stream_Element_Array)
    is
       Last : Stream_Element_Offset;
+
    begin
       Read (S.all, V, Last);
+
       if Last /= V'Last then
          raise Ada.IO_Exceptions.End_Error;
       end if;
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index ff015cc5c08..cdbe34e3a90 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -5257,6 +5257,10 @@ package body Checks is
 
       elsif Is_Entity_Name (Expr)
         and then Is_Known_Valid (Entity (Expr))
+
+        --  Exclude volatile variables
+
+        and then not Treat_As_Volatile (Entity (Expr))
       then
          return True;
 
diff --git a/gcc/ada/csets.adb b/gcc/ada/csets.adb
index 771affc3be0..97b21fa2ea8 100644
--- a/gcc/ada/csets.adb
+++ b/gcc/ada/csets.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -464,11 +464,11 @@ package body Csets is
 
       others => ' ');
 
-   ---------------------------------------------------
-   -- Definitions for Latin-5 (Cyrillic ISO-8859-5) --
-   ---------------------------------------------------
+   -------------------------------------------
+   -- Definitions for Cyrillic (ISO-8859-5) --
+   -------------------------------------------
 
-   Fold_Latin_5 : constant Translate_Table := Translate_Table'(
+   Fold_Cyrillic : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_D0 => X_B0,  X_E0 => X_C0,
       'b' => 'B',  X_D1 => X_B1,  X_E1 => X_C1,  X_F1 => X_A1,
@@ -539,9 +539,9 @@ package body Csets is
 
       others => ' ');
 
-   ------------------------------------------
-   -- Definitions for Latin-9 (ISO 8859-9) --
-   ------------------------------------------
+   -------------------------------------------
+   -- Definitions for Latin-9 (ISO 8859-15) --
+   -------------------------------------------
 
    Fold_Latin_9 : constant Translate_Table := Translate_Table'(
 
@@ -1112,7 +1112,7 @@ package body Csets is
          Fold_Upper := Fold_Latin_4;
 
       elsif Identifier_Character_Set = '5' then
-         Fold_Upper := Fold_Latin_5;
+         Fold_Upper := Fold_Cyrillic;
 
       elsif Identifier_Character_Set = 'p' then
          Fold_Upper := Fold_IBM_PC_437;
diff --git a/gcc/ada/csets.ads b/gcc/ada/csets.ads
index 2f40e36aa8c..bae234760ad 100644
--- a/gcc/ada/csets.ads
+++ b/gcc/ada/csets.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -60,14 +60,14 @@ package Csets is
    --  The character set in use is specified by the value stored in
    --  Opt.Identifier_Character_Set, which has the following settings:
 
-   --    '1'  Latin-1 (ISO-8859-1)
-   --    '2'  Latin-2 (ISO-8859-2)
-   --    '3'  Latin-3 (ISO-8859-3)
-   --    '4'  Latin-4 (ISO-8859-4)
-   --    '5'  Latin-5 (ISO-8859-5, Cyrillic)
-   --    'p'  IBM PC  (code page 437)
-   --    '8'  IBM PC  (code page 850)
-   --    '9'  Latin-9 (ISO-9959-9)
+   --    '1'  Latin-1  (ISO-8859-1)
+   --    '2'  Latin-2  (ISO-8859-2)
+   --    '3'  Latin-3  (ISO-8859-3)
+   --    '4'  Latin-4  (ISO-8859-4)
+   --    '5'  Cyrillic (ISO-8859-5)
+   --    'p'  IBM PC   (code page 437)
+   --    '8'  IBM PC   (code page 850)
+   --    '9'  Latin-9  (ISO-8859-15)
    --    'f'  Full upper set (all distinct)
    --    'n'  No upper characters (Ada/83 rules)
    --    'w'  Latin-1 plus wide characters also allowed
diff --git a/gcc/ada/g-catiio.ads b/gcc/ada/g-catiio.ads
index 523b597e79e..fa8d802eb67 100644
--- a/gcc/ada/g-catiio.ads
+++ b/gcc/ada/g-catiio.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1999-2010, AdaCore                     --
+--                     Copyright (C) 1999-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -111,11 +111,13 @@ package GNAT.Calendar.Time_IO is
    function Image
      (Date    : Ada.Calendar.Time;
       Picture : Picture_String) return String;
-   --  Return Date as a string with format Picture. Raise Picture_Error if
-   --  picture string is null or has an incorrect format.
+   --  Return Date, as interpreted in the current local time zone, as a string
+   --  with format Picture. Raise Picture_Error if picture string is null or
+   --  has an incorrect format.
 
    function Value (Date : String) return Ada.Calendar.Time;
-   --  Parse the string Date and return its equivalent as a Time value. The
+   --  Parse the string Date, interpreted as a time representation in the
+   --  current local time zone, and return the corresponding Time value. The
    --  following time format is supported:
    --
    --     hh:mm:ss             - Date is the current date
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index f6177eb52ee..8f0fa52ae2c 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -702,12 +702,12 @@ package Opt is
    --  GNAT
    --  This variable indicates the character set to be used for identifiers.
    --  The possible settings are:
-   --    '1'  Latin-5 (ISO-8859-1)
-   --    '2'  Latin-5 (ISO-8859-2)
-   --    '3'  Latin-5 (ISO-8859-3)
-   --    '4'  Latin-5 (ISO-8859-4)
-   --    '5'  Latin-5 (ISO-8859-5, Cyrillic)
-   --    '9'  Latin-5 (ISO-8859-9)
+   --    '1'  Latin-1 (ISO-8859-1)
+   --    '2'  Latin-2 (ISO-8859-2)
+   --    '3'  Latin-3 (ISO-8859-3)
+   --    '4'  Latin-4 (ISO-8859-4)
+   --    '5'  Latin-Cyrillic (ISO-8859-5)
+   --    '9'  Latin-9 (ISO-8859-15)
    --    'p'  PC (US, IBM page 437)
    --    '8'  PC (European, IBM page 850)
    --    'f'  Full upper set (all distinct)
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 2b25c9fdd95..9eeaa331f62 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -233,8 +233,8 @@ package body Rtsfind is
 
            --  If the entity being referenced is defined in the current scope,
            --  using it is always fine as such usage can never introduce any
-           --  dependency on an additional unit.
-           --  Why do we need to do this test ???
+           --  dependency on an additional unit. The presence of this test
+           --  helps generating meaningful error messages for CRT violations.
 
            and then Scope (Eid) /= Current_Scope
          then
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 5098d74f8d1..84547c2fb55 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -698,6 +698,21 @@ package body Sem_Aux is
       Obsolescent_Warnings.Init;
    end Initialize;
 
+   -------------
+   -- Is_Body --
+   -------------
+
+   function Is_Body (N : Node_Id) return Boolean is
+   begin
+      return
+        Nkind (N) in N_Body_Stub
+          or else Nkind_In (N, N_Entry_Body,
+                               N_Package_Body,
+                               N_Protected_Body,
+                               N_Subprogram_Body,
+                               N_Task_Body);
+   end Is_Body;
+
    ---------------------
    -- Is_By_Copy_Type --
    ---------------------
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index ed218d712a9..9f574ece1d3 100644
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -259,6 +259,9 @@ package Sem_Aux is
    --  or subtype. This is true if Suppress_Initialization is set either for
    --  the subtype itself, or for the corresponding base type.
 
+   function Is_Body (N : Node_Id) return Boolean;
+   --  Determine whether an arbitrary node denotes a body
+
    function Is_By_Copy_Type (Ent : Entity_Id) return Boolean;
    --  Ent is any entity. Returns True if Ent is a type entity where the type
    --  is required to be passed by copy, as defined in (RM 6.2(3)).
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 671776ad217..58bac3570ed 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2075,6 +2075,12 @@ package body Sem_Ch3 is
       --  (They have the sloc of the label as found in the source, and that
       --  is ahead of the current declarative part).
 
+      procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id);
+      --  Determine whether Body_Decl denotes the body of a late controlled
+      --  primitive (either Initialize, Adjust or Finalize). If this is the
+      --  case, add a proper spec if the body lacks one. The spec is inserted
+      --  before Body_Decl and immedately analyzed.
+
       procedure Remove_Visible_Refinements (Spec_Id : Entity_Id);
       --  Spec_Id is the entity of a package that may define abstract states.
       --  If the states have visible refinement, remove the visibility of each
@@ -2099,6 +2105,70 @@ package body Sem_Ch3 is
          end loop;
       end Adjust_Decl;
 
+      --------------------------------------
+      -- Handle_Late_Controlled_Primitive --
+      --------------------------------------
+
+      procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id) is
+         Body_Spec : constant Node_Id    := Specification (Body_Decl);
+         Body_Id   : constant Entity_Id  := Defining_Entity (Body_Spec);
+         Loc       : constant Source_Ptr := Sloc (Body_Id);
+         Params    : constant List_Id    :=
+                       Parameter_Specifications (Body_Spec);
+         Spec      : Node_Id;
+         Spec_Id   : Entity_Id;
+
+         Dummy : Entity_Id;
+         pragma Unreferenced (Dummy);
+         --  A dummy variable used to capture the unused result of subprogram
+         --  spec analysis.
+
+      begin
+         --  Consider only procedure bodies whose name matches one of type
+         --  [Limited_]Controlled's primitives.
+
+         if Nkind (Body_Spec) /= N_Procedure_Specification
+           or else not Nam_In (Chars (Body_Id), Name_Adjust,
+                                                Name_Finalize,
+                                                Name_Initialize)
+         then
+            return;
+
+         --  A controlled primitive must have exactly one formal whose type
+         --  derives from [Limited_]Controlled.
+
+         elsif List_Length (Params) /= 1 then
+            return;
+         end if;
+
+         Dummy := Analyze_Subprogram_Specification (Body_Spec);
+
+         if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then
+            return;
+         end if;
+
+         Spec_Id := Find_Corresponding_Spec (Body_Decl, Post_Error => False);
+
+         --  The body has a matching spec, therefore it cannot be a late
+         --  primitive.
+
+         if Present (Spec_Id) then
+            return;
+         end if;
+
+         --  At this point the body is known to be a late controlled primitive.
+         --  Generate a matching spec and insert it before the body.
+
+         Spec := New_Copy_Tree (Body_Spec);
+
+         Set_Defining_Unit_Name
+           (Spec, Make_Defining_Identifier (Loc, Chars (Body_Id)));
+
+         Insert_Before_And_Analyze (Body_Decl,
+           Make_Subprogram_Declaration (Loc,
+             Specification => Spec));
+      end Handle_Late_Controlled_Primitive;
+
       --------------------------------
       -- Remove_Visible_Refinements --
       --------------------------------
@@ -2200,6 +2270,9 @@ package body Sem_Ch3 is
       Prag        : Node_Id;
       Spec_Id     : Entity_Id;
 
+      Body_Seen : Boolean := False;
+      --  Flag set when the first body [stub] is encountered
+
       In_Package_Body : Boolean := False;
       --  Flag set when the current declaration list belongs to a package body
 
@@ -2294,15 +2367,28 @@ package body Sem_Ch3 is
          --  care to attach the bodies at a proper place in the tree so as to
          --  not cause unwanted freezing at that point.
 
-         elsif not Analyzed (Next_Decl)
-           and then (Nkind_In (Next_Decl, N_Subprogram_Body,
-                                          N_Entry_Body,
-                                          N_Package_Body,
-                                          N_Protected_Body,
-                                          N_Task_Body)
-                       or else
-                     Nkind (Next_Decl) in N_Body_Stub)
-         then
+         elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl) then
+
+            --  When a controlled type is frozen, the expander generates stream
+            --  and controlled type support routines. If the freeze is caused
+            --  by the stand alone body of Initialize, Adjust and Finalize, the
+            --  expander will end up using the wrong version of these routines
+            --  as the body has not been processed yet. To remedy this, detect
+            --  a late controlled primitive and create a proper spec for it.
+            --  This ensures that the primitive will override its inherited
+            --  counterpart before the freeze takes place.
+
+            --  ??? a cleaner approach may be possible and/or this solution
+            --  could be extended to general-purpose late primitives, TBD.
+
+            if not Body_Seen and then not Is_Body (Decl) then
+               Body_Seen := True;
+
+               if Nkind (Next_Decl) = N_Subprogram_Body then
+                  Handle_Late_Controlled_Primitive (Next_Decl);
+               end if;
+            end if;
+
             Adjust_Decl;
             Freeze_All (Freeze_From, Decl);
             Freeze_From := Last_Entity (Current_Scope);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index b44d4e0f94a..c6e23b586d5 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -4168,10 +4168,11 @@ package body Sem_Ch8 is
       --  generate the precise error message.
 
       function From_Actual_Package (E : Entity_Id) return Boolean;
-      --  Returns true if the entity is declared in a package that is
+      --  Returns true if the entity is an actual for a package that is itself
       --  an actual for a formal package of the current instance. Such an
-      --  entity requires special handling because it may be use-visible
-      --  but hides directly visible entities defined outside the instance.
+      --  entity requires special handling because it may be use-visible but
+      --  hides directly visible entities defined outside the instance, because
+      --  the corresponding formal did so in the generic.
 
       function Is_Actual_Parameter return Boolean;
       --  This function checks if the node N is an identifier that is an actual
@@ -4214,11 +4215,57 @@ package body Sem_Ch8 is
 
       function From_Actual_Package (E : Entity_Id) return Boolean is
          Scop : constant Entity_Id := Scope (E);
-         Act  : Entity_Id;
+         --  Declared scope of candidate entity
+
+         Act : Entity_Id;
+
+         function Declared_In_Actual (Pack : Entity_Id) return Boolean;
+         --  Recursive function that does the work and examines actuals of
+         --  actual packages of current instance.
+
+         ------------------------
+         -- Declared_In_Actual --
+         ------------------------
+
+         function Declared_In_Actual (Pack : Entity_Id) return Boolean is
+            Act : Entity_Id;
+
+         begin
+            if No (Associated_Formal_Package (Pack)) then
+               return False;
+
+            else
+               Act := First_Entity (Pack);
+               while Present (Act) loop
+                  if Renamed_Object (Pack) = Scop then
+                     return True;
+
+                  --  Check for end of list of actuals.
+
+                  elsif Ekind (Act) = E_Package
+                    and then Renamed_Object (Act) = Pack
+                  then
+                     return False;
+
+                  elsif Ekind (Act) = E_Package
+                    and then Declared_In_Actual (Act)
+                  then
+                     return True;
+                  end if;
+
+                  Next_Entity (Act);
+               end loop;
+
+               return False;
+            end if;
+         end Declared_In_Actual;
+
+      --  Start of processing for From_Actual_Package
 
       begin
          if not In_Instance then
             return False;
+
          else
             Inst := Current_Scope;
             while Present (Inst)
@@ -4234,27 +4281,13 @@ package body Sem_Ch8 is
 
             Act := First_Entity (Inst);
             while Present (Act) loop
-               if Ekind (Act) = E_Package then
-
-                  --  Check for end of actuals list
-
-                  if Renamed_Object (Act) = Inst then
-                     return False;
-
-                  elsif Present (Associated_Formal_Package (Act))
-                    and then Renamed_Object (Act) = Scop
-                  then
-                     --  Entity comes from (instance of) formal package
-
-                     return True;
-
-                  else
-                     Next_Entity (Act);
-                  end if;
-
-               else
-                  Next_Entity (Act);
+               if Ekind (Act) = E_Package
+                 and then Declared_In_Actual (Act)
+               then
+                  return True;
                end if;
+
+               Next_Entity (Act);
             end loop;
 
             return False;