aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/sem_ch6.adb8
-rw-r--r--gcc/ada/xr_tabls.adb13
-rw-r--r--gcc/ada/xref_lib.adb30
4 files changed, 47 insertions, 14 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index acdcbd5..96cd485 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+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.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 04242c3..cbdaf68 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/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
diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb
index 95bdfa9..b75da1f 100644
--- a/gcc/ada/xr_tabls.adb
+++ b/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;
diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb
index 77c0075..ed21356 100644
--- a/gcc/ada/xref_lib.adb
+++ b/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