Skip to content

R
riscv-gcc-1
Commit d92eccc3 by Arnaud Charlet Committed by Arnaud Charlet
Options

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
parent 7c4b480f
Showing with 47 additions and 14 deletions
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment