Commit 975f3195 by Nicolas Setton Committed by Arnaud Charlet

exp_dbug.ads, [...] (Get_Variant_Part): Fix the encoding of the "simple_choice"…

exp_dbug.ads, [...] (Get_Variant_Part): Fix the encoding of the "simple_choice" member in a variant record...

2005-06-14  Nicolas Setton  <setton@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* exp_dbug.ads, exp_dbug.adb (Get_Variant_Part): Fix the encoding of
	the "simple_choice" member in a variant record, in accordance with the
	description in the package spec: the information output for a constant
	should be "S number", not "SS number".
	(Get_Encoded_Name): Return at once if not generating code. Avoids name
	overflow problem when compiling with -gnatct, for ASIS/gnatmetrics.

From-SVN: r101034
parent f75ef3af
...@@ -31,7 +31,7 @@ with Einfo; use Einfo; ...@@ -31,7 +31,7 @@ with Einfo; use Einfo;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Sem_Eval; use Sem_Eval; with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
...@@ -492,6 +492,15 @@ package body Exp_Dbug is ...@@ -492,6 +492,15 @@ package body Exp_Dbug is
Has_Suffix : Boolean; Has_Suffix : Boolean;
begin begin
-- If not generating code, there is no need to create encoded
-- names, and problems when the back-end is called to annotate
-- types without full code generation. See comments at beginning
-- of Get_External_Name_With_Suffix for additional details.
if Operating_Mode /= Generate_Code then
return;
end if;
Get_Name_String (Chars (E)); Get_Name_String (Chars (E));
-- Nothing to do if we do not have a type -- Nothing to do if we do not have a type
...@@ -738,20 +747,19 @@ package body Exp_Dbug is ...@@ -738,20 +747,19 @@ package body Exp_Dbug is
Suffix : String) Suffix : String)
is is
Has_Suffix : constant Boolean := (Suffix /= ""); Has_Suffix : constant Boolean := (Suffix /= "");
use type Opt.Operating_Mode_Type;
begin begin
if Opt.Operating_Mode /= Opt.Generate_Code then -- If we are not in code generation mode, this procedure may still be
-- called from Back_End (more specifically - from gigi for doing type
-- representation annotation or some representation-specific checks).
-- But in this mode there is no need to mess with external names.
-- If we are not in code generation mode, we still may call this -- Furthermore, the call causes difficulties in this case because the
-- procedure from Back_End (more specifically - from gigi for doing -- string representing the homonym number is not correctly reset as a
-- type representation annotation or some representation-specific -- part of the call to Output_Homonym_Numbers_Suffix (which is not
-- checks). But in this mode there is no need to mess with external -- called in gigi).
-- names. Furthermore, the call causes difficulties in this case
-- because the string representing the homonym number is not
-- correctly reset as a part of the call to
-- Output_Homonym_Numbers_Suffix (which is not called in gigi)
if Operating_Mode /= Generate_Code then
return; return;
end if; end if;
...@@ -760,7 +768,6 @@ package body Exp_Dbug is ...@@ -760,7 +768,6 @@ package body Exp_Dbug is
if Has_Suffix then if Has_Suffix then
Add_Str_To_Name_Buffer ("___"); Add_Str_To_Name_Buffer ("___");
Add_Str_To_Name_Buffer (Suffix); Add_Str_To_Name_Buffer (Suffix);
Name_Buffer (Name_Len + 1) := ASCII.Nul; Name_Buffer (Name_Len + 1) := ASCII.Nul;
end if; end if;
end Get_External_Name_With_Suffix; end Get_External_Name_With_Suffix;
...@@ -782,9 +789,8 @@ package body Exp_Dbug is ...@@ -782,9 +789,8 @@ package body Exp_Dbug is
procedure Choice_Val (Typ : Character; Choice : Node_Id) is procedure Choice_Val (Typ : Character; Choice : Node_Id) is
begin begin
Add_Char_To_Name_Buffer (Typ);
if Nkind (Choice) = N_Integer_Literal then if Nkind (Choice) = N_Integer_Literal then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Intval (Choice)); Add_Uint_To_Buffer (Intval (Choice));
-- Character literal with no entity present (this is the case -- Character literal with no entity present (this is the case
...@@ -793,6 +799,7 @@ package body Exp_Dbug is ...@@ -793,6 +799,7 @@ package body Exp_Dbug is
elsif Nkind (Choice) = N_Character_Literal elsif Nkind (Choice) = N_Character_Literal
and then No (Entity (Choice)) and then No (Entity (Choice))
then then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Char_Literal_Value (Choice)); Add_Uint_To_Buffer (Char_Literal_Value (Choice));
else else
...@@ -801,6 +808,7 @@ package body Exp_Dbug is ...@@ -801,6 +808,7 @@ package body Exp_Dbug is
begin begin
if Ekind (Ent) = E_Enumeration_Literal then if Ekind (Ent) = E_Enumeration_Literal then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Enumeration_Rep (Ent)); Add_Uint_To_Buffer (Enumeration_Rep (Ent));
else else
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- -- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -432,8 +432,9 @@ package Exp_Dbug is ...@@ -432,8 +432,9 @@ package Exp_Dbug is
-- or is defined within an overloaded subprogram. -- or is defined within an overloaded subprogram.
-- - the string "___" followed by Suffix -- - the string "___" followed by Suffix
-- --
-- If this procedure is called in the ASIS mode, it does nothing. See the -- Note that a call to this procedure has no effect if we are not
-- comments in the body for more details. -- generating code, since the necessary information for computing the
-- proper encoded name is not available in this case.
-------------------------------------------- --------------------------------------------
-- Subprograms for Handling Qualification -- -- Subprograms for Handling Qualification --
...@@ -923,11 +924,13 @@ package Exp_Dbug is ...@@ -923,11 +924,13 @@ package Exp_Dbug is
------------------------------------------------- -------------------------------------------------
procedure Get_Encoded_Name (E : Entity_Id); procedure Get_Encoded_Name (E : Entity_Id);
-- If the entity is a typename, store the external name of -- If the entity is a typename, store the external name of the entity as in
-- the entity as in Get_External_Name, followed by three underscores -- Get_External_Name, followed by three underscores plus the type encoding
-- plus the type encoding in Name_Buffer with the length in Name_Len, -- in Name_Buffer with the length in Name_Len, and an ASCII.NUL character
-- and an ASCII.NUL character stored following the name. -- stored following the name. Otherwise set Name_Buffer and Name_Len to
-- Otherwise set Name_Buffer and Name_Len to hold the entity name. -- hold the entity name. Note that a call to this procedure has no effect
-- if we are not generating code, since the necessary information for
-- computing the proper encoded name is not available in this case.
-------------- --------------
-- Renaming -- -- Renaming --
......
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