2014-07-29 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:10:48 +0000 (13:10 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:10:48 +0000 (13:10 +0000)
* exp_attr.adb, types.ads, types.h, exp_ch11.adb, a-except.adb,
a-except-2005.adb: Add new reason code PE_Stream_Operation_Not_Allowed,
and then use it when a stream operation is used from a library generic
when the restriction (No_Streams) is active.

2014-07-29  Thomas Quinot  <quinot@adacore.com>

* projects.texi: Fix minor typo.

2014-07-29  Yannick Moy  <moy@adacore.com>

* sem_attr.adb (Analyze_Attribute): Fix generation of warning.

2014-07-29  Arnaud Charlet  <charlet@adacore.com>

* sem_ch5.adb (Check_Unreachable_Code): Do not remove code in
CodePeer mode.

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

* exp_ch7.adb (Find_Last_Init): Add local variable
Deep_Init_Found. Check the statement immediately following the
declaration if [Deep_]Initialization was not found.

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

* exp_util.adb (Is_Aliased): It appears that
'reference-d and renamed objects still play some role in Boolean
expression with actions and cannot be finalized immediately.

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

* exp_dbug.adb (Qualify_Needed):  For debugging purposes,
Loop names are not part of the full qualification of entity names.

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

13 files changed:
gcc/ada/ChangeLog
gcc/ada/a-except-2005.adb
gcc/ada/a-except.adb
gcc/ada/exp_attr.adb
gcc/ada/exp_ch11.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_dbug.adb
gcc/ada/exp_util.adb
gcc/ada/projects.texi
gcc/ada/sem_attr.adb
gcc/ada/sem_ch5.adb
gcc/ada/types.ads
gcc/ada/types.h

index 5b18da4..2ccfdf4 100644 (file)
@@ -1,5 +1,42 @@
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
+       * exp_attr.adb, types.ads, types.h, exp_ch11.adb, a-except.adb,
+       a-except-2005.adb: Add new reason code PE_Stream_Operation_Not_Allowed,
+       and then use it when a stream operation is used from a library generic
+       when the restriction (No_Streams) is active.
+
+2014-07-29  Thomas Quinot  <quinot@adacore.com>
+
+       * projects.texi: Fix minor typo.
+
+2014-07-29  Yannick Moy  <moy@adacore.com>
+
+       * sem_attr.adb (Analyze_Attribute): Fix generation of warning.
+
+2014-07-29  Arnaud Charlet  <charlet@adacore.com>
+
+       * sem_ch5.adb (Check_Unreachable_Code): Do not remove code in
+       CodePeer mode.
+
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_ch7.adb (Find_Last_Init): Add local variable
+       Deep_Init_Found. Check the statement immediately following the
+       declaration if [Deep_]Initialization was not found.
+
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_util.adb (Is_Aliased): It appears that
+       'reference-d and renamed objects still play some role in Boolean
+       expression with actions and cannot be finalized immediately.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_dbug.adb (Qualify_Needed):  For debugging purposes,
+       Loop names are not part of the full qualification of entity names.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
        * einfo.adb (Has_Protected): Test base type.
        * sem_ch4.adb (Analyze_Allocator): Reorganize code to make sure
        that we always properly check No_Protected_Type_Allocators.
index 7ed9e03..52de66f 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -456,16 +456,18 @@ package body Ada.Exceptions is
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Missing_Return
      (File : System.Address; Line : Integer);
+   procedure Rcheck_PE_Non_Transportable_Actual
+     (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Potentially_Blocking_Operation
      (File : System.Address; Line : Integer);
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Unchecked_Union_Restriction
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer);
    procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer);
    procedure Rcheck_SE_Explicit_Raise
@@ -545,16 +547,18 @@ package body Ada.Exceptions is
                   "__gnat_rcheck_PE_Misaligned_Address_Value");
    pragma Export (C, Rcheck_PE_Missing_Return,
                   "__gnat_rcheck_PE_Missing_Return");
+   pragma Export (C, Rcheck_PE_Non_Transportable_Actual,
+                  "__gnat_rcheck_PE_Non_Transportable_Actual");
    pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object,
                   "__gnat_rcheck_PE_Overlaid_Controlled_Object");
    pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation,
                   "__gnat_rcheck_PE_Potentially_Blocking_Operation");
+   pragma Export (C, Rcheck_PE_Stream_Operation_Not_Allowed,
+                  "__gnat_rcheck_PE_Stream_Operation_Not_Allowed");
    pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called,
                   "__gnat_rcheck_PE_Stubbed_Subprogram_Called");
    pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction,
                   "__gnat_rcheck_PE_Unchecked_Union_Restriction");
-   pragma Export (C, Rcheck_PE_Non_Transportable_Actual,
-                  "__gnat_rcheck_PE_Non_Transportable_Actual");
    pragma Export (C, Rcheck_SE_Empty_Storage_Pool,
                   "__gnat_rcheck_SE_Empty_Storage_Pool");
    pragma Export (C, Rcheck_SE_Explicit_Raise,
@@ -603,11 +607,12 @@ package body Ada.Exceptions is
    pragma No_Return (Rcheck_PE_Implicit_Return);
    pragma No_Return (Rcheck_PE_Misaligned_Address_Value);
    pragma No_Return (Rcheck_PE_Missing_Return);
+   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object);
    pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation);
+   pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed);
    pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called);
    pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction);
-   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Finalize_Raised_Exception);
    pragma No_Return (Rcheck_SE_Empty_Storage_Pool);
    pragma No_Return (Rcheck_SE_Explicit_Raise);
@@ -668,6 +673,7 @@ package body Ada.Exceptions is
    Rmsg_33 : constant String := "explicit raise"                   & NUL;
    Rmsg_34 : constant String := "infinite recursion"               & NUL;
    Rmsg_35 : constant String := "object too large"                 & NUL;
+   Rmsg_36 : constant String := "stream operation not allowed"     & NUL;
 
    -----------------------
    -- Polling Interface --
@@ -1392,6 +1398,13 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
    end Rcheck_PE_Missing_Return;
 
+   procedure Rcheck_PE_Non_Transportable_Actual
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
+   end Rcheck_PE_Non_Transportable_Actual;
+
    procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer)
    is
@@ -1406,6 +1419,13 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
    end Rcheck_PE_Potentially_Blocking_Operation;
 
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_36'Address);
+   end Rcheck_PE_Stream_Operation_Not_Allowed;
+
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer)
    is
@@ -1420,13 +1440,6 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
    end Rcheck_PE_Unchecked_Union_Restriction;
 
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
-   end Rcheck_PE_Non_Transportable_Actual;
-
    procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer)
    is
index 9e4b1e8..6163204 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -412,16 +412,18 @@ package body Ada.Exceptions is
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Missing_Return
      (File : System.Address; Line : Integer);
+   procedure Rcheck_PE_Non_Transportable_Actual
+     (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Potentially_Blocking_Operation
      (File : System.Address; Line : Integer);
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Unchecked_Union_Restriction
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer);
    procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer);
    procedure Rcheck_SE_Explicit_Raise
@@ -492,16 +494,18 @@ package body Ada.Exceptions is
                   "__gnat_rcheck_PE_Misaligned_Address_Value");
    pragma Export (C, Rcheck_PE_Missing_Return,
                   "__gnat_rcheck_PE_Missing_Return");
+   pragma Export (C, Rcheck_PE_Non_Transportable_Actual,
+                  "__gnat_rcheck_PE_Non_Transportable_Actual");
    pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object,
                   "__gnat_rcheck_PE_Overlaid_Controlled_Object");
    pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation,
                   "__gnat_rcheck_PE_Potentially_Blocking_Operation");
+   pragma Export (C, Rcheck_PE_Stream_Operation_Not_Allowed,
+                  "__gnat_rcheck_PE_Stream_Operation_Not_Allowed");
    pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called,
                   "__gnat_rcheck_PE_Stubbed_Subprogram_Called");
    pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction,
                   "__gnat_rcheck_PE_Unchecked_Union_Restriction");
-   pragma Export (C, Rcheck_PE_Non_Transportable_Actual,
-                  "__gnat_rcheck_PE_Non_Transportable_Actual");
    pragma Export (C, Rcheck_SE_Empty_Storage_Pool,
                   "__gnat_rcheck_SE_Empty_Storage_Pool");
    pragma Export (C, Rcheck_SE_Explicit_Raise,
@@ -542,10 +546,11 @@ package body Ada.Exceptions is
    pragma No_Return (Rcheck_PE_Misaligned_Address_Value);
    pragma No_Return (Rcheck_PE_Missing_Return);
    pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object);
+   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation);
+   pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed);
    pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called);
    pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction);
-   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Finalize_Raised_Exception);
    pragma No_Return (Rcheck_SE_Empty_Storage_Pool);
    pragma No_Return (Rcheck_SE_Explicit_Raise);
@@ -576,6 +581,7 @@ package body Ada.Exceptions is
    procedure Rcheck_19 (File : System.Address; Line : Integer);
    procedure Rcheck_20 (File : System.Address; Line : Integer);
    procedure Rcheck_21 (File : System.Address; Line : Integer);
+   procedure Rcheck_22 (File : System.Address; Line : Integer);
    procedure Rcheck_23 (File : System.Address; Line : Integer);
    procedure Rcheck_24 (File : System.Address; Line : Integer);
    procedure Rcheck_25 (File : System.Address; Line : Integer);
@@ -589,8 +595,7 @@ package body Ada.Exceptions is
    procedure Rcheck_33 (File : System.Address; Line : Integer);
    procedure Rcheck_34 (File : System.Address; Line : Integer);
    procedure Rcheck_35 (File : System.Address; Line : Integer);
-
-   procedure Rcheck_22 (File : System.Address; Line : Integer);
+   procedure Rcheck_36 (File : System.Address; Line : Integer);
 
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
@@ -628,6 +633,7 @@ package body Ada.Exceptions is
    pragma Export (C, Rcheck_33, "__gnat_rcheck_33");
    pragma Export (C, Rcheck_34, "__gnat_rcheck_34");
    pragma Export (C, Rcheck_35, "__gnat_rcheck_35");
+   pragma Export (C, Rcheck_36, "__gnat_rcheck_36");
 
    --  None of these procedures ever returns (they raise an exception). By
    --  using pragma No_Return, we ensure that any junk code after the call,
@@ -668,6 +674,7 @@ package body Ada.Exceptions is
    pragma No_Return (Rcheck_33);
    pragma No_Return (Rcheck_34);
    pragma No_Return (Rcheck_35);
+   pragma No_Return (Rcheck_36);
 
    ---------------------------------------------
    -- Reason Strings for Run-Time Check Calls --
@@ -718,6 +725,7 @@ package body Ada.Exceptions is
    Rmsg_33 : constant String := "explicit raise"                   & NUL;
    Rmsg_34 : constant String := "infinite recursion"               & NUL;
    Rmsg_35 : constant String := "object too large"                 & NUL;
+   Rmsg_36 : constant String := "stream operation not allowed"     & NUL;
 
    -----------------------
    -- Polling Interface --
@@ -1357,6 +1365,13 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
    end Rcheck_PE_Missing_Return;
 
+   procedure Rcheck_PE_Non_Transportable_Actual
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
+   end Rcheck_PE_Non_Transportable_Actual;
+
    procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer)
    is
@@ -1371,6 +1386,13 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
    end Rcheck_PE_Potentially_Blocking_Operation;
 
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_36'Address);
+   end Rcheck_PE_Stream_Operation_Not_Allowed;
+
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer)
    is
@@ -1385,13 +1407,6 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
    end Rcheck_PE_Unchecked_Union_Restriction;
 
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
-   end Rcheck_PE_Non_Transportable_Actual;
-
    procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer)
    is
@@ -1483,6 +1498,8 @@ package body Ada.Exceptions is
      renames Rcheck_PE_Duplicated_Entry_Address;
    procedure Rcheck_22 (File : System.Address; Line : Integer)
      renames Rcheck_PE_Explicit_Raise;
+   procedure Rcheck_23 (File : System.Address; Line : Integer)
+     renames Rcheck_PE_Finalize_Raised_Exception;
    procedure Rcheck_24 (File : System.Address; Line : Integer)
      renames Rcheck_PE_Implicit_Return;
    procedure Rcheck_25 (File : System.Address; Line : Integer)
@@ -1507,9 +1524,8 @@ package body Ada.Exceptions is
      renames Rcheck_SE_Infinite_Recursion;
    procedure Rcheck_35 (File : System.Address; Line : Integer)
      renames Rcheck_SE_Object_Too_Large;
-
-   procedure Rcheck_23 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Finalize_Raised_Exception;
+   procedure Rcheck_36 (File : System.Address; Line : Integer)
+     renames Rcheck_PE_Stream_Operation_Not_Allowed;
 
    -------------
    -- Reraise --
index e96f432..b24c3d1 100644 (file)
@@ -3246,13 +3246,10 @@ package body Exp_Attr is
          --  container). In that case rewrite the attribute as a Raise to
          --  prevent any run-time use.
 
-         --  This is not an explicit raise, the Reason code is wrong, we most
-         --  likely need a new Reason code ???
-
          if Restriction_Active (No_Streams) then
             Rewrite (N,
               Make_Raise_Program_Error (Sloc (N),
-                Reason => PE_Explicit_Raise));
+                Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, B_Type);
             return;
          end if;
@@ -4248,7 +4245,7 @@ package body Exp_Attr is
          if Restriction_Active (No_Streams) then
             Rewrite (N,
               Make_Raise_Program_Error (Sloc (N),
-                Reason => PE_Explicit_Raise));
+                Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, Standard_Void_Type);
             return;
          end if;
@@ -4888,7 +4885,7 @@ package body Exp_Attr is
          if Restriction_Active (No_Streams) then
             Rewrite (N,
               Make_Raise_Program_Error (Sloc (N),
-                Reason => PE_Explicit_Raise));
+                Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, B_Type);
             return;
          end if;
@@ -6600,7 +6597,7 @@ package body Exp_Attr is
          if Restriction_Active (No_Streams) then
             Rewrite (N,
               Make_Raise_Program_Error (Sloc (N),
-                Reason => PE_Explicit_Raise));
+                Reason => PE_Stream_Operation_Not_Allowed));
             Set_Etype (N, U_Type);
             return;
          end if;
index 1a27245..e9e1232 100644 (file)
@@ -2137,16 +2137,18 @@ package body Exp_Ch11 is
             Add_Str_To_Name_Buffer ("PE_Misaligned_Address_Value");
          when PE_Missing_Return =>
             Add_Str_To_Name_Buffer ("PE_Missing_Return");
+         when PE_Non_Transportable_Actual =>
+            Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual");
          when PE_Overlaid_Controlled_Object =>
             Add_Str_To_Name_Buffer ("PE_Overlaid_Controlled_Object");
          when PE_Potentially_Blocking_Operation =>
             Add_Str_To_Name_Buffer ("PE_Potentially_Blocking_Operation");
+         when PE_Stream_Operation_Not_Allowed =>
+            Add_Str_To_Name_Buffer ("PE_Stream_Operation_Not_Allowed");
          when PE_Stubbed_Subprogram_Called =>
             Add_Str_To_Name_Buffer ("PE_Stubbed_Subprogram_Called");
          when PE_Unchecked_Union_Restriction =>
             Add_Str_To_Name_Buffer ("PE_Unchecked_Union_Restriction");
-         when PE_Non_Transportable_Actual =>
-            Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual");
 
          when SE_Empty_Storage_Pool =>
             Add_Str_To_Name_Buffer ("SE_Empty_Storage_Pool");
index c794f7d..1abda22 100644 (file)
@@ -2399,6 +2399,9 @@ package body Exp_Ch7 is
             Stmt   : Node_Id;
             Stmt_2 : Node_Id;
 
+            Deep_Init_Found : Boolean := False;
+            --  A flag set when a call to [Deep_]Initialize has been found
+
          --  Start of processing for Find_Last_Init
 
          begin
@@ -2488,19 +2491,22 @@ package body Exp_Ch7 is
                      Call := Find_Last_Init_In_Block (Stmt_2);
 
                      if Present (Call) then
-                        Last_Init   := Call;
-                        Body_Insert := Stmt_2;
+                        Deep_Init_Found := True;
+                        Last_Init       := Call;
+                        Body_Insert     := Stmt_2;
                      end if;
 
                   elsif Is_Init_Call (Stmt_2) then
-                     Last_Init   := Stmt_2;
-                     Body_Insert := Last_Init;
+                     Deep_Init_Found := True;
+                     Last_Init       := Stmt_2;
+                     Body_Insert     := Last_Init;
                   end if;
+               end if;
 
                --  If the object lacks a call to Deep_Initialize, then it must
                --  have a call to its related type init proc.
 
-               elsif Is_Init_Call (Stmt) then
+               if not Deep_Init_Found and then Is_Init_Call (Stmt) then
                   Last_Init   := Stmt;
                   Body_Insert := Last_Init;
                end if;
index 7337acc..e184cb6 100644 (file)
@@ -1103,7 +1103,8 @@ package body Exp_Dbug is
 
       function Qualify_Needed (S : Entity_Id) return Boolean;
       --  Given a scope, determines if the scope is to be included in the
-      --  fully qualified name, True if so, False if not.
+      --  fully qualified name, True if so, False if not. Blocks and loops
+      --  are excluded from a qualified name.
 
       procedure Set_BNPE_Suffix (E : Entity_Id);
       --  Recursive routine to append the BNPE qualification suffix. Works
@@ -1218,6 +1219,7 @@ package body Exp_Dbug is
             return Is_Subprogram (Ent)
               or else Ekind (Ent) = E_Subprogram_Body
               or else (Ekind (S) /= E_Block
+                        and then Ekind (S) /= E_Loop
                         and then not Is_Dynamic_Scope (S));
          end if;
       end Qualify_Needed;
index 0b6d7a3..6f8ad43 100644 (file)
@@ -4556,17 +4556,6 @@ package body Exp_Util is
       --  Start of processing for Is_Aliased
 
       begin
-         --  'Reference-d or renamed transient objects are not consider aliased
-         --  when the related context is a Boolean expression_with_actions. The
-         --  Boolean result is always known after the action list is evaluated,
-         --  therefore the transient objects must be finalized at that point.
-
-         if Nkind (Rel_Node) = N_Expression_With_Actions
-           and then Is_Boolean_Type (Etype (Rel_Node))
-         then
-            return False;
-         end if;
-
          Stmt := First_Stmt;
          while Present (Stmt) loop
             if Nkind (Stmt) = N_Object_Declaration then
index e23f9fa..d66ed9a 100644 (file)
@@ -1,7 +1,7 @@
 @set gprconfig GPRconfig
 
 @c ------ projects.texi
-@c Copyright (C) 2002-2013, Free Software Foundation, Inc.
+@c Copyright (C) 2002-2014, Free Software Foundation, Inc.
 @c This file is shared between the GNAT user's guide and gprbuild. It is not
 @c compilable on its own, you should instead compile the other two manuals.
 @c For that reason, there is no toplevel @menu
@@ -2465,7 +2465,7 @@ use a project file like:
 
 @smallexample @c projectfile
 aggregate project Agg is
-    for Project_Path use (external("SETUP") % "path");
+    for Project_Path use (external("SETUP") & "path");
     for Project_Files use ("myproject.gpr");
 end Agg;
 
index d22118e..0495c7c 100644 (file)
@@ -412,8 +412,7 @@ package body Sem_Attr is
       procedure Uneval_Old_Msg;
       --  Called when Loop_Entry or Old is used in a potentially unevaluated
       --  expression. Generates appropriate message or warning depending on
-      --  the setting of Opt.Uneval_Old. The caller has put the Name_Id of
-      --  the attribute in Error_Msg_Name_1 prior to the call.
+      --  the setting of Opt.Uneval_Old.
 
       procedure Unexpected_Argument (En : Node_Id);
       --  Signal unexpected attribute argument (En is the argument)
@@ -2284,9 +2283,10 @@ package body Sem_Attr is
                   & "unevaluated must denote an entity");
 
             when 'W' =>
-               Error_Attr_P
+               Error_Msg_Name_1 := Aname;
+               Error_Msg_F
                  ("??prefix of attribute % appears in potentially "
-                  & "unevaluated context, exception may be raised");
+                  & "unevaluated context, exception may be raised", P);
 
             when 'A' =>
                null;
index 265c2c7..3ac6e6b 100644 (file)
@@ -3182,16 +3182,20 @@ package body Sem_Ch5 is
                   --  unreachable code, since it is useless and we don't
                   --  want to generate junk warnings.
 
-                  --  We skip this step if we are not in code generation mode.
+                  --  We skip this step if we are not in code generation mode
+                  --  or CodePeer mode.
                   --  This is the one case where we remove dead code in the
                   --  semantics as opposed to the expander, and we do not want
                   --  to remove code if we are not in code generation mode,
-                  --  since this messes up the ASIS trees.
+                  --  since this messes up the ASIS trees or loses useful
+                  --  information in the CodePeer tree.
 
                   --  Note that one might react by moving the whole circuit to
                   --  exp_ch5, but then we lose the warning in -gnatc mode.
 
-                  if Operating_Mode = Generate_Code then
+                  if Operating_Mode = Generate_Code
+                    and then not CodePeer_Mode
+                  then
                      loop
                         Nxt := Next (N);
 
index 46fb714..c54097b 100644 (file)
@@ -823,12 +823,16 @@ package Types is
    --    1. Modify the type and subtype declarations below appropriately,
    --       keeping things in alphabetical order.
 
-   --    2. Modify the corresponding definitions in types.h, including the
+   --    2. Assign a new number to the reason. Do not renumber existing codes,
+   --       this causes compatibility/bootstrap issues. So always add the new
+   --       code at the end of the existing range.
+
+   --    3. Modify the corresponding definitions in types.h, including the
    --       definition of last_reason_code.
 
-   --    3. Add the name of the routines in exp_ch11.Get_RT_Exception_Name
+   --    4. Add the name of the routines in exp_ch11.Get_RT_Exception_Name
 
-   --    4. Add a new routine in Ada.Exceptions with the appropriate call and
+   --    5. Add a new routine in Ada.Exceptions with the appropriate call and
    --       static string constant. Note that there is more than one version
    --       of a-except.adb which must be modified.
 
@@ -861,24 +865,28 @@ package Types is
       PE_Implicit_Return,                -- 24
       PE_Misaligned_Address_Value,       -- 25
       PE_Missing_Return,                 -- 26
+      PE_Non_Transportable_Actual,       -- 31
       PE_Overlaid_Controlled_Object,     -- 27
       PE_Potentially_Blocking_Operation, -- 28
+      PE_Stream_Operation_Not_Allowed,   -- 36
       PE_Stubbed_Subprogram_Called,      -- 29
       PE_Unchecked_Union_Restriction,    -- 30
-      PE_Non_Transportable_Actual,       -- 31
 
       SE_Empty_Storage_Pool,             -- 32
       SE_Explicit_Raise,                 -- 33
       SE_Infinite_Recursion,             -- 34
       SE_Object_Too_Large);              -- 35
 
+   Last_Reason_Code : constant := 36;
+   --  Last reason code
+
    subtype RT_CE_Exceptions is RT_Exception_Code range
      CE_Access_Check_Failed ..
      CE_Tag_Check_Failed;
 
    subtype RT_PE_Exceptions is RT_Exception_Code range
      PE_Access_Before_Elaboration ..
-     PE_Non_Transportable_Actual;
+     PE_Unchecked_Union_Restriction;
 
    subtype RT_SE_Exceptions is RT_Exception_Code range
      SE_Empty_Storage_Pool ..
index dc3f82f..949065c 100644 (file)
@@ -383,15 +383,16 @@ typedef Int Mechanism_Type;
 #define PE_Implicit_Return                 24
 #define PE_Misaligned_Address_Value        25
 #define PE_Missing_Return                  26
+#define PE_Non_Transportable_Actual        31
 #define PE_Overlaid_Controlled_Object      27
 #define PE_Potentially_Blocking_Operation  28
+#define PE_Stream_Operation_Not_Allowed    36
 #define PE_Stubbed_Subprogram_Called       29
 #define PE_Unchecked_Union_Restriction     30
-#define PE_Non_Transportable_Actual        31
 
 #define SE_Empty_Storage_Pool              32
 #define SE_Explicit_Raise                  33
 #define SE_Infinite_Recursion              34
 #define SE_Object_Too_Large                35
 
-#define LAST_REASON_CODE                   35
+#define LAST_REASON_CODE                   36