[multiple changes]

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* prj.ads, prj-dect.adb, prj-err.ads, prj-err.adb, prj-nmsc.adb,
	prj-strt.ads: Minor reformatting

2009-07-13  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Build_From_Any_Call): For the case of a generic type,
	set the type of the From_Any call to the base type.

2009-07-13  Doug Rupp  <rupp@adacore.com>

	* symbols-processing-vms-ia64.adb (Process): Add variables and
	constants to retrieve and check for symbol visibility.

2009-07-13  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): If conversion is to
	the identical type we remove the conversion completely because
	it is useless.

From-SVN: r149575

10 files changed, 118 insertions, 68 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ac910fd..520a806 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
+	* prj.ads, prj-dect.adb, prj-err.ads, prj-err.adb, prj-nmsc.adb,
+	prj-strt.ads: Minor reformatting
+
+2009-07-13  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_dist.adb (Build_From_Any_Call): For the case of a generic type,
+	set the type of the From_Any call to the base type.
+
+2009-07-13  Doug Rupp  <rupp@adacore.com>
+
+	* symbols-processing-vms-ia64.adb (Process): Add variables and
+	constants to retrieve and check for symbol visibility.
+
+2009-07-13  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): If conversion is to
+	the identical type we remove the conversion completely because
+	it is useless.
+
 2009-07-13  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-err.adb (Error_Msg): One more case where a message should be
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e6e539e..624c878 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7919,6 +7919,13 @@ package body Exp_Ch4 is
       --  the conversion completely, it is useless.
 
       if Operand_Type = Target_Type then
+
+         --  Propagate Assignment_OK attribute to the operand
+
+         if Assignment_OK (N) then
+            Set_Assignment_OK (Operand);
+         end if;
+
          Rewrite (N, Relocate_Node (Operand));
          return;
       end if;
@@ -8506,6 +8513,21 @@ package body Exp_Ch4 is
       Operand_Type : constant Entity_Id := Etype (Operand);
 
    begin
+      --  Nothing at all to do if conversion is to the identical type so remove
+      --  the conversion completely, it is useless.
+
+      if Operand_Type = Target_Type then
+
+         --  Propagate Assignment_OK attribute to the operand
+
+         if Assignment_OK (N) then
+            Set_Assignment_OK (Operand);
+         end if;
+
+         Rewrite (N, Relocate_Node (Operand));
+         return;
+      end if;
+
       --  If we have a conversion of a compile time known value to a target
       --  type and the value is in range of the target type, then we can simply
       --  replace the construct by an integer literal of the correct type. We
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index d975657..b1e77663 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -8617,17 +8617,16 @@ package body Exp_Dist is
             else
                declare
                   Decl : Entity_Id;
-                  Typ  : Entity_Id := U_Type;
 
                begin
                   --  For the subtype representing a generic actual type, go
                   --  to the base type.
 
-                  if Is_Generic_Actual_Type (Typ) then
-                     Typ := Base_Type (Typ);
+                  if Is_Generic_Actual_Type (U_Type) then
+                     U_Type := Base_Type (U_Type);
                   end if;
 
-                  Build_From_Any_Function (Loc, Typ, Decl, Fnam);
+                  Build_From_Any_Function (Loc, U_Type, Decl, Fnam);
                   Append_To (Decls, Decl);
                end;
             end if;
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 9b8baf3..b55a7ed 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -79,10 +79,9 @@ package body Prj.Dect is
       Packages_To_Check : String_List_Access;
       Is_Config_File    : Boolean;
       Flags             : Processing_Flags);
-   --  Parse declarative items. Depending on In_Zone, some declarative
-   --  items may be forbidden.
-   --  Is_Config_File should be set to True if the project represents a config
-   --  file (.cgpr) since some specific checks apply.
+   --  Parse declarative items. Depending on In_Zone, some declarative items
+   --  may be forbidden. Is_Config_File should be set to True if the project
+   --  represents a config file (.cgpr) since some specific checks apply.
 
    procedure Parse_Package_Declaration
      (In_Tree             : Project_Node_Tree_Ref;
diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb
index c0fa09b..8e0d562 100644
--- a/gcc/ada/prj-err.adb
+++ b/gcc/ada/prj-err.adb
@@ -99,9 +99,11 @@ package body Prj.Err is
       end if;
 
       if Real_Location = No_Location then
+
          --  If still null, we are parsing a project that was created in-memory
          --  so we shouldn't report errors for projects that the user has no
          --  access to in any case.
+
          return;
       end if;
 
@@ -115,7 +117,7 @@ package body Prj.Err is
       if Flags.Report_Error /= null then
          Flags.Report_Error
            (Project,
-            Is_Warning => Msg (Msg'First) = '?' or Msg (Msg'First) = '<');
+            Is_Warning => Msg (Msg'First) = '?' or else Msg (Msg'First) = '<');
       end if;
    end Error_Msg;
 
diff --git a/gcc/ada/prj-err.ads b/gcc/ada/prj-err.ads
index e697e19..d07285e 100644
--- a/gcc/ada/prj-err.ads
+++ b/gcc/ada/prj-err.ads
@@ -73,11 +73,10 @@ package Prj.Err is
       Location : Source_Ptr := No_Location;
       Project  : Project_Id := null);
    --  Output an error message, either through Flags.Error_Report or through
-   --  Errutil. The location defaults to the project's location ("project" in
-   --  the source code).
-   --  If Msg starts with "?", this is a warning, and Warning: is added at the
-   --  beginning. If Msg starts with "<", see comment for
-   --  Err_Vars.Error_Msg_Warn
+   --  Errutil. The location defaults to the project's location ("project"
+   --  in the source code). If Msg starts with "?", this is a warning, and
+   --  Warning: is added at the beginning. If Msg starts with "<", see comment
+   --  for Err_Vars.Error_Msg_Warn.
 
    -------------
    -- Scanner --
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 3ad892a..7b04af7 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -196,13 +196,13 @@ package body Prj.Nmsc is
       Kind                : Source_Kind;
       File_Name           : File_Name_Type;
       Display_File        : File_Name_Type;
-      Naming_Exception    : Boolean := False;
+      Naming_Exception    : Boolean          := False;
       Path                : Path_Information := No_Path_Information;
-      Alternate_Languages : Language_List := null;
-      Unit                : Name_Id    := No_Name;
-      Index               : Int        := 0;
-      Locally_Removed     : Boolean    := False;
-      Location            : Source_Ptr := No_Location);
+      Alternate_Languages : Language_List    := null;
+      Unit                : Name_Id          := No_Name;
+      Index               : Int              := 0;
+      Locally_Removed     : Boolean          := False;
+      Location            : Source_Ptr       := No_Location);
    --  Add a new source to the different lists: list of all sources in the
    --  project tree, list of source of a project and list of sources of a
    --  language.
@@ -539,19 +539,20 @@ package body Prj.Nmsc is
       Kind                : Source_Kind;
       File_Name           : File_Name_Type;
       Display_File        : File_Name_Type;
-      Naming_Exception    : Boolean := False;
+      Naming_Exception    : Boolean          := False;
       Path                : Path_Information := No_Path_Information;
-      Alternate_Languages : Language_List := null;
-      Unit                : Name_Id    := No_Name;
-      Index               : Int        := 0;
-      Locally_Removed     : Boolean    := False;
-      Location            : Source_Ptr := No_Location)
+      Alternate_Languages : Language_List    := null;
+      Unit                : Name_Id          := No_Name;
+      Index               : Int              := 0;
+      Locally_Removed     : Boolean          := False;
+      Location            : Source_Ptr       := No_Location)
    is
       Config    : constant Language_Config := Lang_Id.Config;
       UData     : Unit_Index;
       Add_Src   : Boolean;
       Source    : Source_Id;
       Prev_Unit : Unit_Index := No_Unit_Index;
+
       Source_To_Replace : Source_Id := No_Source;
 
    begin
@@ -619,12 +620,12 @@ package body Prj.Nmsc is
                end if;
             end if;
 
-            --  Do not allow the same unit name in different projects,
-            --  except if one is extending the other.
+            --  Do not allow the same unit name in different projects, except
+            --  if one is extending the other.
 
-            --  For a file based language, the same file name replaces
-            --  a file in a project being extended, but it is allowed
-            --  to have the same file name in unrelated projects.
+            --  For a file based language, the same file name replaces a file
+            --  in a project being extended, but it is allowed to have the same
+            --  file name in unrelated projects.
 
          elsif Is_Extending (Project, Source.Project) then
             if not Locally_Removed then
diff --git a/gcc/ada/prj-strt.ads b/gcc/ada/prj-strt.ads
index 0f6d0d0..7dbe530 100644
--- a/gcc/ada/prj-strt.ads
+++ b/gcc/ada/prj-strt.ads
@@ -37,10 +37,10 @@ private package Prj.Strt is
    --  On entry, the current token is the first literal string following
    --  a left parenthesis in a string type declaration such as:
    --    type Toto is ("string_1", "string_2", "string_3");
-   --  On exit, the current token is the right parenthesis.
-   --  The parameter First_String is a node that contained the first
-   --  literal string of the string type, linked with the following
-   --  literal strings.
+   --
+   --  On exit, the current token is the right parenthesis. The parameter
+   --  First_String is a node that contained the first literal string of the
+   --  string type, linked with the following literal strings.
    --
    --  Report an error if
    --    - a literal string is not found at the beginning of the list
@@ -50,24 +50,22 @@ private package Prj.Strt is
    procedure Start_New_Case_Construction
      (In_Tree     : Project_Node_Tree_Ref;
       String_Type : Project_Node_Id);
-   --  This procedure is called at the beginning of a case construction
-   --  The parameter String_Type is the node for the string type
-   --  of the case label variable.
-   --  The different literal strings of the string type are stored
-   --  into a table to be checked against the case labels of the
-   --  case construction.
+   --  This procedure is called at the beginning of a case construction The
+   --  parameter String_Type is the node for the string type of the case label
+   --  variable. The different literal strings of the string type are stored
+   --  into a table to be checked against the case labels of the case
+   --  construction.
 
    procedure End_Case_Construction
      (Check_All_Labels   : Boolean;
       Case_Location      : Source_Ptr;
       Flags              : Processing_Flags);
-   --  This procedure is called at the end of a case construction
-   --  to remove the case labels and to restore the previous state.
-   --  In particular, in the case of nested case constructions,
-   --  the case labels of the enclosing case construction are restored.
-   --  When When_Others is False and we are not in quiet output, a warning
-   --  is emitted for each value of the case variable string type that has
-   --  not been specified.
+   --  This procedure is called at the end of a case construction to remove the
+   --  case labels and to restore the previous state. In particular, in the
+   --  case of nested case constructions, the case labels of the enclosing case
+   --  construction are restored. When When_Others is False and we are not in
+   --  quiet output, a warning is emitted for each value of the case variable
+   --  string type that has not been specified.
 
    procedure Parse_Choice_List
      (In_Tree      : Project_Node_Tree_Ref;
@@ -86,12 +84,13 @@ private package Prj.Strt is
       Current_Package : Project_Node_Id;
       Optional_Index  : Boolean;
       Flags           : Processing_Flags);
-   --  Parse a simple string expression or a string list expression.
-   --  Current_Project is the node of the project file being parsed.
-   --  Current_Package is the node of the package being parsed,
-   --  or Empty_Node when we are at the project level (not in a package).
-   --  On exit, Expression is the node of the expression that has
-   --  been parsed.
+   --  Parse a simple string expression or a string list expression
+   --
+   --  Current_Project is the node of the project file being parsed
+   --
+   --  Current_Package is the node of the package being parsed, or Empty_Node
+   --  when we are at the project level (not in a package). On exit, Expression
+   --  is the node of the expression that has been parsed.
 
    procedure Parse_Variable_Reference
      (In_Tree         : Project_Node_Tree_Ref;
@@ -99,13 +98,12 @@ private package Prj.Strt is
       Current_Project : Project_Node_Id;
       Current_Package : Project_Node_Id;
       Flags           : Processing_Flags);
-   --  Parse a variable or attribute reference.
-   --  Used internally (in expressions) and for case variables (in Prj.Dect).
-   --  Current_Package is the node of the package being parsed,
-   --  or Empty_Node when we are at the project level (not in a package).
-   --  On exit, Variable is the node of the variable or attribute reference.
-   --  A variable reference is made of one to three simple names.
-   --  An attribute reference is made of one or two simple names,
+   --  Parse variable or attribute reference. Used internally (in expressions)
+   --  and for case variables (in Prj.Dect). Current_Package is the node of the
+   --  package being parsed, or Empty_Node when we are at the project level
+   --  (not in a package). On exit, Variable is the node of the variable or
+   --  attribute reference. A variable reference is made of one to three simple
+   --  names. An attribute reference is made of one or two simple names,
    --  followed by an apostrophe, followed by the attribute simple name.
 
 end Prj.Strt;
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 27ee5f0..ff2e01f 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1362,12 +1362,13 @@ package Prj is
    --    - Error:   issue an error, causes the tool to fail
 
    type Error_Handler is access procedure
-     (Project : Project_Id; Is_Warning : Boolean);
+     (Project    : Project_Id;
+      Is_Warning : Boolean);
    --  This warngs when an error was found when parsing a project. The error
-   --  itself is handled through Prj.Err (and you should call
-   --  Prj.Err.Finalize to actually print the error). This ensures that
-   --  duplicate error messages are always correctly removed, that errors msgs
-   --  are sorted, and that all tools will report the same error to the user.
+   --  itself is handled through Prj.Err (and Prj.Err.Finalize should be called
+   --  to actually print the error). This ensures that duplicate error messages
+   --  are always correctly removed, that errors msgs are sorted, and that all
+   --  tools will report the same error to the user.
 
    function Create_Flags
      (Report_Error               : Error_Handler;
diff --git a/gcc/ada/symbols-processing-vms-ia64.adb b/gcc/ada/symbols-processing-vms-ia64.adb
index 0eb1af7..beb099e 100644
--- a/gcc/ada/symbols-processing-vms-ia64.adb
+++ b/gcc/ada/symbols-processing-vms-ia64.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2009, 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- --
@@ -85,9 +85,14 @@ package body Processing is
 
       Stname  : Integer;
       Stinfo  : Character;
+      Stother : Character;
       Sttype  : Integer;
       Stbind  : Integer;
       Stshndx : Integer;
+      Stvis   : Integer;
+
+      STV_Internal : constant := 1;
+      STV_Hidden   : constant := 2;
 
       Section_Headers : Section_Header_Ptr;
 
@@ -340,7 +345,7 @@ package body Processing is
       while Offset < End_Symtab loop
          Get_Word (Stname);
          Get_Byte (Stinfo);
-         Get_Byte (B);
+         Get_Byte (Stother);
          Get_Half (Stshndx);
          for J in 1 .. 4 loop
             Get_Word (W);
@@ -348,10 +353,13 @@ package body Processing is
 
          Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
          Stbind := Integer'(Character'Pos (Stinfo)) / 16;
+         Stvis  := Integer'(Character'Pos (Stother)) mod 4;
 
          if (Sttype = 1 or else Sttype = 2)
               and then Stbind /= 0
               and then Stshndx /= 0
+              and then Stvis /= STV_Internal
+              and then Stvis /= STV_Hidden
          then
             --  Check if this is a symbol from a generic body