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
This commit is contained in:
Nicolas Setton 2005-06-16 10:37:52 +02:00 committed by Arnaud Charlet
parent f75ef3af65
commit 975f319568
2 changed files with 33 additions and 22 deletions

View File

@ -31,7 +31,7 @@ with Einfo; use Einfo;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt;
with Opt; use Opt;
with Output; use Output;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
@ -492,6 +492,15 @@ package body Exp_Dbug is
Has_Suffix : Boolean;
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));
-- Nothing to do if we do not have a type
@ -738,20 +747,19 @@ package body Exp_Dbug is
Suffix : String)
is
Has_Suffix : constant Boolean := (Suffix /= "");
use type Opt.Operating_Mode_Type;
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
-- procedure 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. 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)
-- 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;
end if;
@ -760,7 +768,6 @@ package body Exp_Dbug is
if Has_Suffix then
Add_Str_To_Name_Buffer ("___");
Add_Str_To_Name_Buffer (Suffix);
Name_Buffer (Name_Len + 1) := ASCII.Nul;
end if;
end Get_External_Name_With_Suffix;
@ -782,9 +789,8 @@ package body Exp_Dbug is
procedure Choice_Val (Typ : Character; Choice : Node_Id) is
begin
Add_Char_To_Name_Buffer (Typ);
if Nkind (Choice) = N_Integer_Literal then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Intval (Choice));
-- Character literal with no entity present (this is the case
@ -793,6 +799,7 @@ package body Exp_Dbug is
elsif Nkind (Choice) = N_Character_Literal
and then No (Entity (Choice))
then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Char_Literal_Value (Choice));
else
@ -801,6 +808,7 @@ package body Exp_Dbug is
begin
if Ekind (Ent) = E_Enumeration_Literal then
Add_Char_To_Name_Buffer (Typ);
Add_Uint_To_Buffer (Enumeration_Rep (Ent));
else

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -432,8 +432,9 @@ package Exp_Dbug is
-- or is defined within an overloaded subprogram.
-- - the string "___" followed by Suffix
--
-- If this procedure is called in the ASIS mode, it does nothing. See the
-- comments in the body for more details.
-- 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.
--------------------------------------------
-- Subprograms for Handling Qualification --
@ -923,11 +924,13 @@ package Exp_Dbug is
-------------------------------------------------
procedure Get_Encoded_Name (E : Entity_Id);
-- If the entity is a typename, store the external name of
-- the entity as in Get_External_Name, followed by three underscores
-- plus the type encoding in Name_Buffer with the length in Name_Len,
-- and an ASCII.NUL character stored following the name.
-- Otherwise set Name_Buffer and Name_Len to hold the entity name.
-- If the entity is a typename, store the external name of the entity as in
-- Get_External_Name, followed by three underscores plus the type encoding
-- in Name_Buffer with the length in Name_Len, and an ASCII.NUL character
-- stored following the name. Otherwise set Name_Buffer and Name_Len to
-- 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 --