diff options
-rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 8 | ||||
-rw-r--r-- | gcc/ada/xr_tabls.adb | 13 | ||||
-rw-r--r-- | gcc/ada/xref_lib.adb | 30 |
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 |