The RM forbids local names from being renamings, hence the
attempt to specify an attribute such as size or alignment
for a renaming should be illegal. We detected this for the
case of an address clause but missed many other cases.
The following should compile with the messages shown
with -gnatj60 -gnatld7
1. package BadRenameAttr is
2. type r is record
3. a, b, c, d : Character;
4. end record;
5.
6. B : R;
7. C : R renames B;
8. for C'Alignment use 8;
|
>>> alignment clause not allowed for a renaming
declaration (RM 13.1(6))
9.
10. D : R renames B;
11. for D'Size use 128;
|
>>> size clause not allowed for a renaming
declaration (RM 13.1(6))
12. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-12-20 Robert Dewar <de...@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
renaming case.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 182532)
+++ sem_ch13.adb (working copy)
@@ -2184,18 +2184,41 @@
U_Ent := Underlying_Type (Ent);
end if;
- -- Complete other routine error checks
+ -- Avoid cascaded error
if Etype (Nam) = Any_Type then
return;
+ -- Must be declared in current scope
+
elsif Scope (Ent) /= Current_Scope then
Error_Msg_N ("entity must be declared in this scope", Nam);
return;
+ -- Must not be a source renaming (we do have some cases where the
+ -- expander generates a renaming, and those cases are OK, in such
+ -- cases any attribute applies to the renamed object as well.
+
+ elsif Is_Object (Ent)
+ and then Present (Renamed_Object (Ent))
+ and then Comes_From_Source (Renamed_Object (Ent))
+ then
+ Get_Name_String (Chars (N));
+ Error_Msg_Strlen := Name_Len;
+ Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
+ Error_Msg_N
+ ("~ clause not allowed for a renaming declaration (RM 13.1(6))",
+ Nam);
+ return;
+
+ -- If no underlying entity, use entity itself, applies to some
+ -- previously detected error cases ???
+
elsif No (U_Ent) then
U_Ent := Ent;
+ -- Cannot specify for a subtype (exception Object/Value_Size)
+
elsif Is_Type (U_Ent)
and then not Is_First_Subtype (U_Ent)
and then Id /= Attribute_Object_Size
@@ -2367,12 +2390,6 @@
then
Error_Msg_N ("constant overlays a variable?", Expr);
- elsif Present (Renamed_Object (U_Ent)) then
- Error_Msg_N
- ("address clause not allowed"
- & " for a renaming declaration (RM 13.1(6))", Nam);
- return;
-
-- Imported variables can have an address clause, but then
-- the import is pretty meaningless except to suppress
-- initializations, so we do not need such variables to
@@ -2523,10 +2540,16 @@
elsif Align /= No_Uint then
Set_Has_Alignment_Clause (U_Ent);
+ -- Tagged type case, check for attempt to set alignment to a
+ -- value greater than Max_Align, and reset if so.
+
if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
Error_Msg_N
("?alignment for & set to Maximum_Aligment", Nam);
- Set_Alignment (U_Ent, Max_Align);
+ Set_Alignment (U_Ent, Max_Align);
+
+ -- All other cases
+
else
Set_Alignment (U_Ent, Align);
end if;
@@ -6057,7 +6080,7 @@
Aspect_Type_Invariant =>
T := Standard_Boolean;
- when Aspect_Dimension |
+ when Aspect_Dimension |
Aspect_Dimension_System =>
raise Program_Error;
@@ -8792,8 +8815,8 @@
Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target;
- Source_Siz : Uint;
- Target_Siz : Uint;
+ Source_Siz : Uint;
+ Target_Siz : Uint;
begin
-- This validation check, which warns if we have unequal sizes for
