xr_tabls.adb, [...]: Update to latest lib-xref.ads Fix handling of parameters.

2010-06-23  Arnaud Charlet  <charlet@adacore.com>

	* xr_tabls.adb, xref_lib.adb: Update to latest lib-xref.ads
	Fix handling of parameters.
	Add protection against unexpected cases.
	* sem_ch6.adb (Create_Extra_Formals): Use suffix "L" instead of "A" for
	access level, since "A" suffix is already used elsewhere. Similarly,
	use suffix "O" instead of "C" for 'Constrained since "C" suffix is used
	for xxx'Class.

From-SVN: r161260

gcc/ada/ChangeLog

+2010-06-23  Arnaud Charlet  <charlet@adacore.com>
+
+	* xr_tabls.adb, xref_lib.adb: Update to latest lib-xref.ads
+	Fix handling of parameters.
+	Add protection against unexpected cases.
+	* sem_ch6.adb (Create_Extra_Formals): Use suffix "L" instead of "A" for
+	access level, since "A" suffix is already used elsewhere. Similarly,
+	use suffix "O" instead of "C" for 'Constrained since "C" suffix is used
+	for xxx'Class.
+
 2010-06-23  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_util.adb, sem_util.ads: Minor reformatting.

gcc/ada/sem_ch6.adb

@@ -5435,8 +5435,8 @@ package body Sem_Ch6 is
       --  without coordinating with CodePeer, which makes use of these to
       --  provide better messages.
 
-      --  C denotes the Constrained bit.
-      --  A denotes the accessibility level.
+      --  O denotes the Constrained bit.
+      --  L denotes the accessibility level.
       --  BIP_xxx denotes an extra formal for a build-in-place function. See
       --  the full list in exp_ch6.BIP_Formal_Kind.
 
@@ -5565,7 +5565,7 @@ package body Sem_Ch6 is
               and then not Is_Indefinite_Subtype (Formal_Type)
             then
                Set_Extra_Constrained
-                 (Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "C"));
+                 (Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "O"));
             end if;
          end if;
 
@@ -5598,7 +5598,7 @@ package body Sem_Ch6 is
                or else Present (Extra_Accessibility (P_Formal)))
          then
             Set_Extra_Accessibility
-              (Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "A"));
+              (Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "L"));
          end if;
 
          --  This label is required when skipping extra formal generation for

gcc/ada/xr_tabls.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2010, 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- --
@@ -395,7 +395,7 @@ package body Xr_Tabls is
 
    begin
       case Ref_Type is
-         when 'b' | 'c' | 'm' | 'r' | 'R' | 'i' | ' ' | 'x' =>
+         when 'b' | 'c' | 'H' | 'm' | 'o' | 'r' | 'R' | 'i' | ' ' | 'x' =>
             null;
 
          when 'l' | 'w' =>
@@ -419,7 +419,12 @@ package body Xr_Tabls is
                  (Symbol_Length => 0,
                   Symbol        => "",
                   Key           => new String'(Key),
-                  Decl          => null,
+                  Decl          => new Reference_Record'
+                                     (File          => File_Ref,
+                                      Line          => Line,
+                                      Column        => Column,
+                                      Source_Line   => null,
+                                      Next          => null),
                   Is_Parameter  => True,
                   Decl_Type     => ' ',
                   Body_Ref      => null,
@@ -458,7 +463,7 @@ package body Xr_Tabls is
             New_Ref.Next          := Declaration.Body_Ref;
             Declaration.Body_Ref  := New_Ref;
 
-         when 'r' | 'R' | 'i' | 'l' | ' ' | 'x' | 'w' =>
+         when 'r' | 'R' | 'H' | 'i' | 'l' | 'o' | ' ' | 'x' | 'w' =>
             New_Ref.Next          := Declaration.Ref_Ref;
             Declaration.Ref_Ref   := New_Ref;
 

gcc/ada/xref_lib.adb

@@ -508,6 +508,7 @@ package body Xref_Lib is
          when 'D' => return "decimal type";
          when 'E' => return "enumeration type";
          when 'F' => return "float type";
+         when 'H' => return "abstract type";
          when 'I' => return "integer type";
          when 'M' => return "modular type";
          when 'O' => return "fixed type";
@@ -523,7 +524,6 @@ package body Xref_Lib is
          when 'd' => return Param_String & "decimal object";
          when 'e' => return Param_String & "enumeration object";
          when 'f' => return Param_String & "float object";
-         when 'h' => return "interface";
          when 'i' => return Param_String & "integer object";
          when 'm' => return Param_String & "modular object";
          when 'o' => return Param_String & "fixed object";
@@ -535,6 +535,8 @@ package body Xref_Lib is
          when 'x' => return Param_String & "abstract procedure";
          when 'y' => return Param_String & "abstract function";
 
+         when 'h' => return "interface";
+         when 'g' => return "macro";
          when 'K' => return "package";
          when 'k' => return "generic package";
          when 'L' => return "statement label";
@@ -542,6 +544,7 @@ package body Xref_Lib is
          when 'N' => return "named number";
          when 'n' => return "enumeration literal";
          when 'q' => return "block label";
+         when 'Q' => return "include file";
          when 'U' => return "procedure";
          when 'u' => return "generic procedure";
          when 'V' => return "function";
@@ -557,7 +560,11 @@ package body Xref_Lib is
          --  have an unknown Abbrev value
 
          when others =>
-            return "??? (" & Get_Type (Decl) & ")";
+            if Is_Parameter (Decl) then
+               return "parameter";
+            else
+               return "??? (" & Get_Type (Decl) & ")";
+            end if;
       end case;
    end Get_Full_Type;
 
@@ -1587,8 +1594,13 @@ package body Xref_Lib is
                File := Get_File_Ref (Arr (R));
                F := Osint.To_Host_File_Spec
                  (Get_Gnatchop_File (Arr (R), Full_Path_Name));
-               Write_Str (F.all & ' ');
-               Free (F);
+
+               if F = null then
+                  Write_Str ("<unknown> ");
+               else
+                  Write_Str (F.all & ' ');
+                  Free (F);
+               end if;
             end if;
 
             Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R)));
@@ -1637,8 +1649,14 @@ package body Xref_Lib is
          Write_Str ("  Decl:  ");
          F := Osint.To_Host_File_Spec
                (Get_Gnatchop_File (Decl, Full_Path_Name));
-         Print80 (F.all & ' ');
-         Free (F);
+
+         if F = null then
+            Print80 ("<unknown> ");
+         else
+            Print80 (F.all & ' ');
+            Free (F);
+         end if;
+
          Print_Ref (Get_Line (Decl), Get_Column (Decl));
 
          Print_List