2014-02-19 Yannick Moy <moy@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 19 Feb 2014 10:59:25 +0000 (10:59 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 19 Feb 2014 10:59:25 +0000 (10:59 +0000)
* sinfo.ads: Minor comment update.

2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>

* atree.ads: Minor reformatting (change Entity_Info to Einfo).

2014-02-19  Thomas Quinot  <quinot@adacore.com>

* exp_ch7.adb (Find_Node_To_Be_Wrapped): An assignment statement
that has the No_Ctrl_Actions flag is a suitable node to be
wrapped if the assigned expression has no finalization actions.
* sem_eval.adb (Eval_Entity_Name): For a compile time known
boolean value, mark the corresponding condition SCO as constant.

2014-02-19  Robert Dewar  <dewar@adacore.com>

* exp_util.adb: Minor reformatting.
* exp_util.ads (Matching_Standard_Type): New function.
* exp_ch7.adb: Minor reformatting.

2014-02-19  Ed Schonberg  <schonberg@adacore.com>

* sem_ch13.adb (Get_Cursor_Type): Use scope of iterable type
to find declaration for Cursor, to handle properly the case of
a discriminated iterable type.

2014-02-19  Vincent Celier  <celier@adacore.com>

* gnatcmd.adb (GNATCmd): Always replace the object dirs of
imported library projects with the library ALI dirs, when setting
the object paths.
* prj-env.ads (Ada_Objects_Path): Correct comments about
argument Including_Libraries.

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

gcc/ada/ChangeLog
gcc/ada/atree.ads
gcc/ada/exp_ch7.adb
gcc/ada/exp_util.adb
gcc/ada/exp_util.ads
gcc/ada/gnatcmd.adb
gcc/ada/prj-env.adb
gcc/ada/prj-env.ads
gcc/ada/sem_ch13.adb
gcc/ada/sem_eval.adb
gcc/ada/sinfo.ads

index 2126995..92b8355 100644 (file)
@@ -1,3 +1,39 @@
+2014-02-19  Yannick Moy  <moy@adacore.com>
+
+       * sinfo.ads: Minor comment update.
+
+2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * atree.ads: Minor reformatting (change Entity_Info to Einfo).
+
+2014-02-19  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_ch7.adb (Find_Node_To_Be_Wrapped): An assignment statement
+       that has the No_Ctrl_Actions flag is a suitable node to be
+       wrapped if the assigned expression has no finalization actions.
+       * sem_eval.adb (Eval_Entity_Name): For a compile time known
+       boolean value, mark the corresponding condition SCO as constant.
+
+2014-02-19  Robert Dewar  <dewar@adacore.com>
+
+       * exp_util.adb: Minor reformatting.
+       * exp_util.ads (Matching_Standard_Type): New function.
+       * exp_ch7.adb: Minor reformatting.
+
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Get_Cursor_Type): Use scope of iterable type
+       to find declaration for Cursor, to handle properly the case of
+       a discriminated iterable type.
+
+2014-02-19  Vincent Celier  <celier@adacore.com>
+
+       * gnatcmd.adb (GNATCmd): Always replace the object dirs of
+       imported library projects with the library ALI dirs, when setting
+       the object paths.
+       * prj-env.ads (Ada_Objects_Path): Correct comments about
+       argument Including_Libraries.
+
 2014-02-19  Gary Dismukes  <dismukes@adacore.com>
 
        * gnat_rm.texi: Minor spelling fixes.
index b167d8f..0603d11 100644 (file)
@@ -47,18 +47,17 @@ package Atree is
 --  program internally. Syntactic and semantic information is combined in
 --  this tree. There is no separate symbol table structure.
 
---  WARNING: There is a C version of this package. Any changes to this
---  source file must be properly reflected in the C header file atree.h
+--  WARNING: There is a C version of this package. Any changes to this source
+--  file must be properly reflected in the C header file atree.h
 
 --  Package Atree defines the basic structure of the tree and its nodes and
---  provides the basic abstract interface for manipulating the tree. Two
---  other packages use this interface to define the representation of Ada
---  programs using this tree format. The package Sinfo defines the basic
---  representation of the syntactic structure of the program, as output
---  by the parser. The package Entity_Info defines the semantic information
---  which is added to the tree nodes that represent declared entities (i.e.
---  the information which might typically be described in a separate symbol
---  table structure).
+--  provides the basic abstract interface for manipulating the tree. Two other
+--  packages use this interface to define the representation of Ada programs
+--  using this tree format. The package Sinfo defines the basic representation
+--  of the syntactic structure of the program, as output by the parser. The
+--  package Einfo defines the semantic information which is added to the tree
+--  nodes that represent declared entities (i.e. the information which might
+--  typically be described in a separate symbol table structure).
 
 --  The front end of the compiler first parses the program and generates a
 --  tree that is simply a syntactic representation of the program in abstract
index 822f689..79b609d 100644 (file)
@@ -4184,10 +4184,15 @@ package body Exp_Ch7 is
 
             --  Usually assignments are good candidate for wrapping except
             --  when they have been generated as part of a controlled aggregate
-            --  where the wrapping should take place more globally.
+            --  where the wrapping should take place more globally. Note that
+            --  No_Ctrl_Actions may be set also for non-controlled assignements
+            --  in order to disable the use of dispatching _assign, so we need
+            --  to test explicitly for a controlled type here.
 
             when N_Assignment_Statement =>
-               if No_Ctrl_Actions (The_Parent) then
+               if No_Ctrl_Actions (The_Parent)
+                 and then Needs_Finalization (Etype (Name (The_Parent)))
+               then
                   null;
                else
                   return The_Parent;
index b3f6c19..27559d7 100644 (file)
@@ -3950,6 +3950,43 @@ package body Exp_Util is
       end if;
    end Insert_Actions_After;
 
+   ------------------------
+   -- Insert_Declaration --
+   ------------------------
+
+   procedure Insert_Declaration (N : Node_Id; Decl : Node_Id) is
+      P : Node_Id;
+
+   begin
+      pragma Assert (Nkind (N) in N_Subexpr);
+
+      --  Climb until we find a procedure or a package
+
+      P := Parent (N);
+      loop
+         if Is_List_Member (P) then
+            exit when Nkind_In (Parent (P), N_Package_Specification,
+                                            N_Package_Body,
+                                            N_Subprogram_Body);
+
+            --  Special handling for handled sequence of statements, we must
+            --  insert in the statements not the exception handlers!
+
+            if Nkind (Parent (P)) = N_Handled_Sequence_Of_Statements then
+               P := First (Statements (Parent (P)));
+               exit;
+            end if;
+         end if;
+
+         P := Parent (P);
+      end loop;
+
+      --  Now do the insertion
+
+      Insert_Before (P, Decl);
+      Analyze (Decl);
+   end Insert_Declaration;
+
    ---------------------------------
    -- Insert_Library_Level_Action --
    ---------------------------------
@@ -5924,6 +5961,68 @@ package body Exp_Util is
               Constraints => List_Constr));
    end Make_Subtype_From_Expr;
 
+   ----------------------------
+   -- Matching_Standard_Type --
+   ----------------------------
+
+   function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id is
+      pragma Assert (Is_Scalar_Type (Typ));
+      Siz : constant Uint := Esize (Typ);
+
+   begin
+      --  Float-point cases
+
+      if Is_Floating_Point_Type (Typ) then
+         if Siz <= Esize (Standard_Short_Float) then
+            return Standard_Short_Float;
+         elsif Siz <= Esize (Standard_Float) then
+            return Standard_Float;
+         elsif Siz <= Esize (Standard_Long_Float) then
+            return Standard_Long_Float;
+         elsif Siz <= Esize (Standard_Long_Long_Float) then
+            return Standard_Long_Long_Float;
+         else
+            raise Program_Error;
+         end if;
+
+      --  Integer cases (includes fixed-point types)
+
+      --  Unsigned cases (includes normal enumeration types)
+
+      elsif Is_Unsigned_Type (Typ) then
+         if Siz <= Esize (Standard_Short_Short_Unsigned) then
+            return Standard_Short_Short_Unsigned;
+         elsif Siz <= Esize (Standard_Short_Unsigned) then
+            return Standard_Short_Unsigned;
+         elsif Siz <= Esize (Standard_Unsigned) then
+            return Standard_Unsigned;
+         elsif Siz <= Esize (Standard_Long_Unsigned) then
+            return Standard_Long_Unsigned;
+         elsif Siz <= Esize (Standard_Long_Long_Unsigned) then
+            return Standard_Long_Long_Unsigned;
+         else
+            raise Program_Error;
+         end if;
+
+      --  Signed cases
+
+      else
+         if Siz <= Esize (Standard_Short_Short_Integer) then
+            return Standard_Short_Short_Integer;
+         elsif Siz <= Esize (Standard_Short_Integer) then
+            return Standard_Short_Integer;
+         elsif Siz <= Esize (Standard_Integer) then
+            return Standard_Integer;
+         elsif Siz <= Esize (Standard_Long_Integer) then
+            return Standard_Long_Integer;
+         elsif Siz <= Esize (Standard_Long_Long_Integer) then
+            return Standard_Long_Long_Integer;
+         else
+            raise Program_Error;
+         end if;
+      end if;
+   end Matching_Standard_Type;
+
    -----------------------------
    -- May_Generate_Large_Temp --
    -----------------------------
index 808af98..f14117c 100644 (file)
@@ -140,6 +140,18 @@ package Exp_Util is
    --  generalize to expressions if there is a need but this is tricky to
    --  implement because of short-circuits (among other things).???
 
+   procedure Insert_Declaration (N : Node_Id; Decl : Node_Id);
+   --  N must be a subexpression (Nkind in N_Subexpr). This is similar to
+   --  Insert_Action (N, Decl), but inserts Decl outside the expression in
+   --  which N appears. This is called Insert_Declaration because the intended
+   --  use is for declarations that have no associated code. We can't go
+   --  moving other kinds of things out of the current expression, since they
+   --  could be executed conditionally (e.g. right operand of short circuit,
+   --  or THEN/ELSE of if expression). This is currently used only in
+   --  Modify_Tree_For_C mode, where it is needed because in C we have no
+   --  way of having declarations within an expression (a really annoying
+   --  limitation).
+
    procedure Insert_Library_Level_Action (N : Node_Id);
    --  This procedure inserts and analyzes the node N as an action at the
    --  library level for the current unit (i.e. it is attached to the
@@ -678,6 +690,12 @@ package Exp_Util is
    --  expression E. Unc_Typ is an unconstrained array or record, or
    --  a classwide type.
 
+   function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id;
+   --  Given a scalar subtype Typ, returns a matching type in standard that
+   --  has the same object size value. For example, a 16 bit signed type will
+   --  typically return Standard_Short_Integer. For fixed-point types, this
+   --  will return integer types of the corresponding size.
+
    function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean;
    --  Determines if the given type, Typ, may require a large temporary of the
    --  kind that causes back-end trouble if stack checking is enabled. The
index 1bca7d8..5d8a935 100644 (file)
@@ -1040,6 +1040,7 @@ procedure GNATCmd is
                 "accept project file switches -vPx, -Pprj and -Xnam=val");
       New_Line;
    end Non_VMS_Usage;
+
    ------------------
    -- Process_Link --
    ------------------
@@ -2106,7 +2107,7 @@ begin
          --  Set up the env vars for project path files
 
          Prj.Env.Set_Ada_Paths
-           (Project, Project_Tree, Including_Libraries => False);
+           (Project, Project_Tree, Including_Libraries => True);
 
          --  For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
          --  a configuration pragmas file, if necessary.
index 43bc578..0bb0eb1 100644 (file)
@@ -1681,8 +1681,6 @@ package body Prj.Env is
          Path : Path_Name_Type;
 
       begin
-         --  ??? This is almost the equivalent of For_All_Source_Dirs
-
          if Process_Source_Dirs then
 
             --  Add to path all source directories of this project if there are
index 831ce8c..21239b4 100644 (file)
@@ -92,7 +92,7 @@ package Prj.Env is
       Including_Libraries : Boolean := True) return String_Access;
    --  Get the ADA_OBJECTS_PATH of a Project file. For the first call with the
    --  exact same parameters, compute it and cache it. When Including_Libraries
-   --  is False, the object directory of a library project is replaced with the
+   --  is True, the object directory of a library project is replaced with the
    --  library ALI directory of this project (usually the library directory of
    --  the project, except when attribute Library_ALI_Dir is declared) except
    --  when the library ALI directory does not contain any ALI file.
index 7e2a09c..7c4d266 100644 (file)
@@ -128,9 +128,9 @@ package body Sem_Ch13 is
    --  Uint value. If the value is inappropriate, then error messages are
    --  posted as required, and a value of No_Uint is returned.
 
-   function Get_Cursor_Type return Entity_Id;
-   --  Find Cursor type by name in the current scope, used to resolve primitive
-   --  operations of an iterable type.
+   function Get_Cursor_Type (S : Entity_Id) return Entity_Id;
+   --  Find Cursor type by name in the scope of an iterable type, for use in
+   --  resolving the primitive operations of the type.
 
    function Is_Operational_Item (N : Node_Id) return Boolean;
    --  A specification for a stream attribute is allowed before the full type
@@ -8059,7 +8059,7 @@ package body Sem_Ch13 is
             T := Entity (ASN);
 
             declare
-               Cursor : constant Entity_Id := Get_Cursor_Type;
+               Cursor : constant Entity_Id := Get_Cursor_Type (Scope (T));
                Assoc  : Node_Id;
                Expr   : Node_Id;
             begin
@@ -9749,7 +9749,7 @@ package body Sem_Ch13 is
    -- Get_Cursor_Type --
    ---------------------
 
-   function Get_Cursor_Type return Entity_Id is
+   function Get_Cursor_Type (S : Entity_Id) return Entity_Id is
       C : Entity_Id;
       E : Entity_Id;
 
@@ -9758,7 +9758,7 @@ package body Sem_Ch13 is
       --  used in iterable primitives.
 
       C := Empty;
-      E := First_Entity (Current_Scope);
+      E := First_Entity (S);
       while Present (E) loop
          if Chars (E) = Name_Cursor and then Is_Type (E) then
             C := E;
@@ -11455,7 +11455,7 @@ package body Sem_Ch13 is
       Expr  : Node_Id;
 
       Prim   : Node_Id;
-      Cursor : constant Entity_Id := Get_Cursor_Type;
+      Cursor : constant Entity_Id := Get_Cursor_Type (Scope (Typ));
 
       First_Id       : Entity_Id;
       Next_Id        : Entity_Id;
index 4d69021..51b84f6 100644 (file)
@@ -37,6 +37,7 @@ with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
+with Par_SCO;  use Par_SCO;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
@@ -1955,8 +1956,8 @@ package body Sem_Eval is
 
       elsif Ekind (Def_Id) = E_Constant then
 
-         --  Deferred constants must always be treated as nonstatic
-         --  outside the scope of their full view.
+         --  Deferred constants must always be treated as nonstatic outside the
+         --  scope of their full view.
 
          if Present (Full_View (Def_Id))
            and then not In_Open_Scopes (Scope (Def_Id))
@@ -1978,6 +1979,16 @@ package body Sem_Eval is
                Validate_Static_Object_Name (N);
             end if;
 
+            --  Mark constant condition in SCOs
+
+            if Generate_SCO
+              and then Comes_From_Source (N)
+              and then Is_Boolean_Type (Etype (Def_Id))
+              and then Compile_Time_Known_Value (N)
+            then
+               Set_SCO_Condition (N, Expr_Value_E (N) = Standard_True);
+            end if;
+
             return;
          end if;
       end if;
index b5769f8..cb8b0ee 100644 (file)
@@ -550,7 +550,7 @@ package Sinfo is
    --  do not lead to data dependences for subprograms can be safely ignored.
 
    --  In addition pragma Debug statements are removed from the tree (rewritten
-   --  to NULL stmt), since they should be taken into account in flow analysis.
+   --  to NULL stmt), since they should be ignored in formal verification.
 
    --  An error is also issued for missing subunits, similar to the warning
    --  issued when generating code, to avoid formal verification of a partial