[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 29 Jan 2013 14:31:08 +0000 (15:31 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 29 Jan 2013 14:31:08 +0000 (15:31 +0100)
2013-01-29  Thomas Quinot  <quinot@adacore.com>

* sprint.adb (Sprint_Node_Actual): Output freeze nodes for
itypes even if Dump_Freeze_Null is not set.

2013-01-29  Robert Dewar  <dewar@adacore.com>

* sem_util.adb: Minor reformatting.
* s-rident.ads: Minor comment fixes.

2013-01-29  Pascal Obry  <obry@adacore.com>

* prj-env.ads, prj-env.adb (Add_Directories): Add parameter to
control if the path is prepended or appended.

From-SVN: r195544

gcc/ada/ChangeLog
gcc/ada/prj-env.adb
gcc/ada/prj-env.ads
gcc/ada/s-rident.ads
gcc/ada/sem_util.adb
gcc/ada/sprint.adb

index 076ae03f8336bf4bd1ec12eb7acb9e3f18afc164..f23c566acfb4b7ac691f6db55d4c12eda3b72f74 100644 (file)
@@ -1,3 +1,18 @@
+2013-01-29  Thomas Quinot  <quinot@adacore.com>
+
+       * sprint.adb (Sprint_Node_Actual): Output freeze nodes for
+       itypes even if Dump_Freeze_Null is not set.
+
+2013-01-29  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.adb: Minor reformatting.
+       * s-rident.ads: Minor comment fixes.
+
+2013-01-29  Pascal Obry  <obry@adacore.com>
+
+       * prj-env.ads, prj-env.adb (Add_Directories): Add parameter to
+       control if the path is prepended or appended.
+
 2013-01-29  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch6.adb (Analyze_Expression_Function): An expression
index ddff02fcb92ac57148d1a4190a8fb0a97b538d18..d4bda03aac647024d5e93b74c3ed2587bf218de7 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -1836,8 +1836,9 @@ package body Prj.Env is
    ---------------------
 
    procedure Add_Directories
-     (Self : in out Project_Search_Path;
-      Path : String)
+     (Self    : in out Project_Search_Path;
+      Path    : String;
+      Prepend : Boolean := False)
    is
       Tmp : String_Access;
    begin
@@ -1845,7 +1846,11 @@ package body Prj.Env is
          Self.Path := new String'(Uninitialized_Prefix & Path);
       else
          Tmp := Self.Path;
-         Self.Path := new String'(Tmp.all & Path_Separator & Path);
+         if Prepend then
+            Self.Path := new String'(Path & Path_Separator & Tmp.all);
+         else
+            Self.Path := new String'(Tmp.all & Path_Separator & Path);
+         end if;
          Free (Tmp);
       end if;
 
index e2bb4448da5df7e44193c0561f8c411917234c1f..39d805c2bc6f92d345c094ffe38d3587543aada0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -189,8 +189,9 @@ package Prj.Env is
    --  Free the memory used by Self
 
    procedure Add_Directories
-     (Self : in out Project_Search_Path;
-      Path : String);
+     (Self    : in out Project_Search_Path;
+      Path    : String;
+      Prepend : Boolean := False);
    --  Add one or more directories to the path. Directories added with this
    --  procedure are added in order after the current directory and before the
    --  path given by the environment variable GPR_PROJECT_PATH. A value of "-"
index d0bc1066c0cc3437e1480393ff39989e8681ccc7..fcdf2ad87f7c74da628312fd1e90fe5766293871 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, 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- --
@@ -382,10 +382,11 @@ package System.Rident is
       --  value of the parameter permitted by the profile.
    end record;
 
-   Profile_Info : constant array (Profile_Name_Actual) of Profile_Data :=
+   Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := (
 
-                    (No_Implementation_Extensions =>
-                        --  Restrictions for Restricted profile
+                     --  No_Implementation_Extensions profile
+
+                     No_Implementation_Extensions =>
 
                        (Set   =>
                           (No_Implementation_Aspect_Specifications => True,
index c467f50ac9f29b606a8fbfc8be9f868472893f94..0fc236559002063a72a60283e3e3750c67ece453 100644 (file)
@@ -1242,7 +1242,8 @@ package body Sem_Util is
       --  Return the entity associated with the function call
 
       procedure Preanalyze_Without_Errors (N : Node_Id);
-      --  Preanalyze N without reporting errors
+      --  Preanalyze N without reporting errors. Very dubious, you can't just
+      --  go analyzing things more than once???
 
       -------------------------
       -- Collect_Identifiers --
@@ -1273,14 +1274,12 @@ package body Sem_Util is
                if No (Entity (N)) then
                   return Skip;
 
-               --  We don't collect identifiers of packages, called functions,
-               --  etc.
+               --  Don't collect identifiers of packages, called functions, etc
 
-               elsif Ekind_In (Entity (N),
-                       E_Package,
-                       E_Function,
-                       E_Procedure,
-                       E_Entry)
+               elsif Ekind_In (Entity (N), E_Package,
+                                           E_Function,
+                                           E_Procedure,
+                                           E_Entry)
                then
                   return Skip;
 
@@ -1350,21 +1349,22 @@ package body Sem_Util is
             pragma Assert (Nkind (N) in N_Has_Entity);
 
             Elmt : Elmt_Id;
+
          begin
             if List = No_Elist then
                return False;
             end if;
 
             Elmt := First_Elmt (List);
-            loop
-               if No (Elmt) then
-                  return False;
-               elsif Entity (Node (Elmt)) = Entity (N) then
+            while Present (Elmt) loop
+               if Entity (Node (Elmt)) = Entity (N) then
                   return True;
                else
                   Next_Elmt (Elmt);
                end if;
             end loop;
+
+            return False;
          end Contains;
 
          ------------------
@@ -1397,6 +1397,7 @@ package body Sem_Util is
       function Get_Function_Id (Call : Node_Id) return Entity_Id is
          Nam : constant Node_Id := Name (Call);
          Id  : Entity_Id;
+
       begin
          if Nkind (Nam) = N_Explicit_Dereference then
             Id := Etype (Nam);
@@ -1432,15 +1433,14 @@ package body Sem_Util is
    begin
       if Ada_Version < Ada_2012
         or else (not (Nkind (N) in N_Op)
-                   and then not (Nkind (N) in N_Membership_Test)
-                   and then not Nkind_In (N,
-                                  N_Range,
-                                  N_Aggregate,
-                                  N_Extension_Aggregate,
-                                  N_Full_Type_Declaration,
-                                  N_Function_Call,
-                                  N_Procedure_Call_Statement,
-                                  N_Entry_Call_Statement))
+                  and then not (Nkind (N) in N_Membership_Test)
+                  and then not Nkind_In (N, N_Range,
+                                            N_Aggregate,
+                                            N_Extension_Aggregate,
+                                            N_Full_Type_Declaration,
+                                            N_Function_Call,
+                                            N_Procedure_Call_Statement,
+                                            N_Entry_Call_Statement))
         or else (Nkind (N) = N_Full_Type_Declaration
                    and then not Is_Record_Type (Defining_Identifier (N)))
       then
@@ -1502,6 +1502,7 @@ package body Sem_Util is
                Comp   : Node_Id;
                Def_Id : Entity_Id := Defining_Identifier (N);
                Rec    : Node_Id   := Get_Record_Part (N);
+
             begin
                --  No need to perform any analysis if the record has no
                --  components
@@ -1650,9 +1651,8 @@ package body Sem_Util is
                      end loop;
 
                      Num_Components :=
-                       Expr_Value (High_Bound (Aggregate_Bounds (N)))
-                         - Expr_Value (Low_Bound (Aggregate_Bounds (N)))
-                         + 1;
+                       Expr_Value (High_Bound (Aggregate_Bounds (N))) -
+                         Expr_Value (Low_Bound (Aggregate_Bounds (N))) + 1;
 
                      pragma Assert (Count_Components <= Num_Components);
 
@@ -1735,8 +1735,7 @@ package body Sem_Util is
 
                            if Nkind (Choice) in N_Has_Entity
                              and then Present (Entity (Choice))
-                             and then Ekind (Entity (Choice))
-                                        = E_Discriminant
+                             and then Ekind (Entity (Choice)) = E_Discriminant
                            then
                               null;
 
index bfa245fd9dc284832eab3ccc8ecb7916e8211a49..6aa045ff4e29488c63715bd72278dcc7fef3da21 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, 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- --
@@ -70,7 +70,10 @@ package body Sprint is
    --  or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
 
    Dump_Freeze_Null : Boolean;
-   --  Set True if freeze nodes and non-source null statements output
+   --  Set True if empty freeze nodes and non-source null statements output.
+   --  Note that freeze nodes containing freeze actions are always output,
+   --  as are freeze nodes for itypes, which in general have the effect of
+   --  causing elaboration of the itype.
 
    Freeze_Indent : Int := 0;
    --  Keep track of freeze indent level (controls output of blank lines before
@@ -1827,7 +1830,15 @@ package body Sprint is
             if Dump_Original_Only then
                null;
 
-            elsif Present (Actions (Node)) or else Dump_Freeze_Null then
+            --  A freeze node is output if it has some effect (i.e. non-empty
+            --  actions, or freeze node for an itype, which causes elaboration
+            --  of the itype), and is also always output if Dump_Freeze_Null
+            --  is set True.
+
+            elsif Present (Actions (Node))
+              or else Is_Itype (Entity (Node))
+              or else Dump_Freeze_Null
+            then
                Write_Indent;
                Write_Rewrite_Str ("<<<");
                Write_Str_With_Col_Check_Sloc ("freeze ");
@@ -4084,7 +4095,7 @@ package body Sprint is
 
                   when E_Modular_Integer_Type =>
                      Write_Header;
-                     Write_Str (" mod ");
+                     Write_Str ("mod ");
                      Write_Uint_With_Col_Check (Modulus (Typ), Auto);
 
                   --  Floating point types and subtypes