git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2010-10-11  Gary Dismukes  <dismukes@adacore.com>

	* sem_disp.adb (Check_Dispatching_Operation): Revise test for warning
	about nondispatching subprograms to use In_Same_List (reducing use of
	Parent links).

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* xr_tabls.adb, sem_res.adb, lib-xref.adb, lib-xref.ads: Use s for
	reference in a static call.

2010-10-11  Steve Baird  <baird@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case Type_Key): Type_Key
	attribute should always be transformed into a string literal in
	Analyze_Attribute.
	* par-ch4.adb: Type_Key attribute's type is String; update value of
	Is_Parameterless_Attribute constant to reflect this.
	* sem_attr.adb (Analyze_Attribute): Recognize Type_Key attribute and
	rewrite it as a string literal (attribute value is always known
	statically).
	* snames.ads-tmpl: Add entries for Type_Key attribute.

From-SVN: r165285
This commit is contained in:
Arnaud Charlet 2010-10-11 11:30:15 +02:00
parent 21a5b575cf
commit 9c870c905e
10 changed files with 84 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2010-10-11 Gary Dismukes <dismukes@adacore.com>
* sem_disp.adb (Check_Dispatching_Operation): Revise test for warning
about nondispatching subprograms to use In_Same_List (reducing use of
Parent links).
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* xr_tabls.adb, sem_res.adb, lib-xref.adb, lib-xref.ads: Use s for
reference in a static call.
2010-10-11 Steve Baird <baird@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, case Type_Key): Type_Key
attribute should always be transformed into a string literal in
Analyze_Attribute.
* par-ch4.adb: Type_Key attribute's type is String; update value of
Is_Parameterless_Attribute constant to reflect this.
* sem_attr.adb (Analyze_Attribute): Recognize Type_Key attribute and
rewrite it as a string literal (attribute value is always known
statically).
* snames.ads-tmpl: Add entries for Type_Key attribute.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* lib-xref.adb (Output_References): Common handling for objects and

1
gcc/ada/exp_attr.adb
View File

@ -5355,6 +5355,7 @@ package body Exp_Attr is
Attribute_Stub_Type |
Attribute_Target_Name |
Attribute_Type_Class |
Attribute_Type_Key |
Attribute_Unconstrained_Array |
Attribute_Universal_Literal_String |
Attribute_Wchar_T_Size |

2
gcc/ada/lib-xref.adb
View File

@ -470,7 +470,7 @@ package body Lib.Xref is
and then Is_Ada_2005_Only (E)
and then Ada_Version < Ada_2005
and then Warn_On_Ada_2005_Compatibility
and then (Typ = 'm' or else Typ = 'r')
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's')
then
Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
end if;

6
gcc/ada/lib-xref.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -183,6 +183,7 @@ package Lib.Xref is
-- P = overriding primitive operation
-- r = reference
-- R = subprogram reference in dispatching call
-- s = subprogram reference in a static call
-- t = end of body
-- w = WITH line
-- x = type extension
@ -296,6 +297,9 @@ package Lib.Xref is
-- the specification of the primitive operation of the root
-- type when the call has a controlling argument in its class.
-- s is used to mark a static subprogram call. The reference is
-- to the specification of the subprogram being called.
-- t is similar to e. It identifies the end of a corresponding
-- body (such a reference always links up with a b reference)

1
gcc/ada/par-ch4.adb
View File

@ -42,6 +42,7 @@ package body Ch4 is
Attribute_Base => True,
Attribute_Class => True,
Attribute_Stub_Type => True,
Attribute_Type_Key => True,
others => False);
-- This map contains True for parameterless attributes that return a
-- string or a type. For those attributes, a left parenthesis after

43
gcc/ada/sem_attr.adb
View File

@ -4449,6 +4449,48 @@ package body Sem_Attr is
Check_PolyORB_Attribute;
Set_Etype (N, RTE (RE_TypeCode));
--------------
-- Type_Key --
--------------
when Attribute_Type_Key =>
Check_E0;
Check_Type;
declare
function Type_Key return String;
-- A very preliminary implementation.
-- For now, a signature consists of only the type name.
-- This is clearly incomplete (e.g., adding a new field to
-- a record type should change the type's Type_Key attribute).
--------------
-- Type_Key --
--------------
function Type_Key return String is
Full_Name : constant String_Id :=
Fully_Qualified_Name_String (Entity (P));
Signature : String
(1 .. Integer (String_Length (Full_Name)) - 1);
-- Decrement length to omit trailing NUL
begin
for J in Signature'Range loop
Signature (J) :=
Get_Character (Get_String_Char (Full_Name, Int (J)));
end loop;
return Signature & "'Type_Key";
end Type_Key;
begin
Rewrite (N, Make_String_Literal (Loc, Type_Key));
end;
Analyze_And_Resolve (N, Standard_String);
-----------------
-- UET_Address --
-----------------
@ -7596,6 +7638,7 @@ package body Sem_Attr is
Attribute_Target_Name |
Attribute_Terminated |
Attribute_To_Address |
Attribute_Type_Key |
Attribute_UET_Address |
Attribute_Unchecked_Access |
Attribute_Universal_Literal_String |

7
gcc/ada/sem_disp.adb
View File

@ -1045,14 +1045,13 @@ package body Sem_Disp is
-- case it looks suspiciously like an attempt to define a primitive
-- operation, which requires the declaration to be in a package spec
-- (3.2.3(6)). Only report cases where the type and subprogram are
-- in the same declaration list (by comparing the unit nodes reached
-- via Parent links), to avoid spurious warnings on subprograms in
-- in the same declaration list (by checking the enclosing parent
-- declarations), to avoid spurious warnings on subprograms in
-- instance bodies when the type is declared in the instance spec but
-- hasn't been frozen by the instance body.
elsif not Is_Frozen (Tagged_Type)
and then
Parent (Parent (Tagged_Type)) = Parent (Parent (Parent (Subp)))
and then In_Same_List (Parent (Tagged_Type), Parent (Parent (Subp)))
then
Error_Msg_N
("?not dispatching (must be defined in a package spec)", Subp);

4
gcc/ada/sem_res.adb
View File

@ -5527,10 +5527,10 @@ package body Sem_Res is
then
Generate_Reference (Nam, Subp, 'R');
-- Normal case, not a dispatching call
-- Normal case, not a dispatching call. Generate a call reference.
else
Generate_Reference (Nam, Subp);
Generate_Reference (Nam, Subp, 's');
end if;
if Is_Intrinsic_Subprogram (Nam) then

2
gcc/ada/snames.ads-tmpl
View File

@ -801,6 +801,7 @@ package Snames is
Name_Terminated : constant Name_Id := N + $;
Name_To_Address : constant Name_Id := N + $; -- GNAT
Name_Type_Class : constant Name_Id := N + $; -- GNAT
Name_Type_Key : constant Name_Id := N + $; -- GNAT
Name_UET_Address : constant Name_Id := N + $; -- GNAT
Name_Unbiased_Rounding : constant Name_Id := N + $;
Name_Unchecked_Access : constant Name_Id := N + $;
@ -1316,6 +1317,7 @@ package Snames is
Attribute_Terminated,
Attribute_To_Address,
Attribute_Type_Class,
Attribute_Type_Key,
Attribute_UET_Address,
Attribute_Unbiased_Rounding,
Attribute_Unchecked_Access,

5
gcc/ada/xr_tabls.adb
View File

@ -395,7 +395,8 @@ package body Xr_Tabls is
begin
case Ref_Type is
when 'b' | 'c' | 'H' | 'm' | 'o' | 'r' | 'R' | 'i' | ' ' | 'x' =>
when 'b' | 'c' | 'H' | 'm' | 'o' | 'r' | 'R' |
's' | 'i' | ' ' | 'x' =>
null;
when 'l' | 'w' =>
@ -463,7 +464,7 @@ package body Xr_Tabls is
New_Ref.Next := Declaration.Body_Ref;
Declaration.Body_Ref := New_Ref;
when 'r' | 'R' | 'H' | 'i' | 'l' | 'o' | ' ' | 'x' | 'w' =>
when 'r' | 'R' | 's' | 'H' | 'i' | 'l' | 'o' | ' ' | 'x' | 'w' =>
New_Ref.Next := Declaration.Ref_Ref;
Declaration.Ref_Ref := New_Ref;