2012-07-09 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Extend previous change to elementary types.
2012-07-09 Javier Miranda <miranda@adacore.com>
* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Reverse
previous patch since unconditionally handling as renaming_as_body
renamings of predefined dispatching equality and unequality operator
cause visibility problems with private overridings of the equality
operator (see ACATS
C854001).
2012-07-09 Vincent Pucci <pucci@adacore.com>
* exp_attr.adb (Signal_Bad_Attribute): Raise Program_Error in
case of internal attribute names (already rejected by the parser).
* par-ch13.adb (P_Representation_Clause): Complain if an internal
attribute name that comes from source occurs.
* par-ch4.adb (P_Name): Complain if an internal attribute name
occurs in the context of an attribute reference.
* par-util.adb (Signal_Bad_Attribute): Don't complain about
mispelling attribute with internal attributes.
* sem_attr.adb (Analyze_Attribute): Raise Program_Error in case
of internal attribute names (already rejected by the parser).
* snames.adb-tmpl (Is_Internal_Attribute_Name): New routine.
* snames.ads-tmpl: Attributes CPU, Dispatching_Domain and
Interrupt_Priority are marked as INT attributes since they
don't denote real attribute and are only used internally in
the compiler.
(Is_Internal_Attribute_Name): New routine.
From-SVN: r189378
+2012-07-09 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb: Extend previous change to elementary types.
+
+2012-07-09 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Reverse
+ previous patch since unconditionally handling as renaming_as_body
+ renamings of predefined dispatching equality and unequality operator
+ cause visibility problems with private overridings of the equality
+ operator (see ACATS C854001).
+
+2012-07-09 Vincent Pucci <pucci@adacore.com>
+
+ * exp_attr.adb (Signal_Bad_Attribute): Raise Program_Error in
+ case of internal attribute names (already rejected by the parser).
+ * par-ch13.adb (P_Representation_Clause): Complain if an internal
+ attribute name that comes from source occurs.
+ * par-ch4.adb (P_Name): Complain if an internal attribute name
+ occurs in the context of an attribute reference.
+ * par-util.adb (Signal_Bad_Attribute): Don't complain about
+ mispelling attribute with internal attributes.
+ * sem_attr.adb (Analyze_Attribute): Raise Program_Error in case
+ of internal attribute names (already rejected by the parser).
+ * snames.adb-tmpl (Is_Internal_Attribute_Name): New routine.
+ * snames.ads-tmpl: Attributes CPU, Dispatching_Domain and
+ Interrupt_Priority are marked as INT attributes since they
+ don't denote real attribute and are only used internally in
+ the compiler.
+ (Is_Internal_Attribute_Name): New routine.
+
2012-07-09 Thomas Quinot <quinot@adacore.com>
* einfo.adb (Set_Reverse_Storage_Order): Update assertion,
Attribute_Default_Iterator |
Attribute_Implicit_Dereference |
Attribute_Iterator_Element |
- Attribute_Variable_Indexing => null;
+ Attribute_Variable_Indexing =>
+ null;
- -- Attributes related to Ada 2012 aspects
+ -- Internal attributes used to deal with Ada 2012 delayed aspects
+ -- (already diagnosed by parser, thus nothing more to do here).
when Attribute_CPU |
Attribute_Dispatching_Domain |
- Attribute_Interrupt_Priority => null;
+ Attribute_Interrupt_Priority =>
+ raise Program_Error;
------------
-- Access --
-- Handle cases where we build a body for a renamed equality
if Is_Entity_Name (Nam)
- and then (Chars (Entity (Nam)) = Name_Op_Ne
- or else Chars (Entity (Nam)) = Name_Op_Eq)
+ and then Chars (Entity (Nam)) = Name_Op_Eq
and then Scope (Entity (Nam)) = Standard_Standard
then
declare
-- untagged record type (AI05-0123).
if Ada_Version >= Ada_2012
- and then Chars (Entity (Nam)) = Name_Op_Eq
and then Is_Record_Type (Typ)
and then not Is_Tagged_Type (Typ)
and then not Is_Frozen (Typ)
Expand_Record_Equality
(Id,
Typ => Typ,
- Lhs =>
- Make_Identifier (Loc, Chars (First_Formal (Id))),
- Rhs =>
- Make_Identifier
- (Loc, Chars (Next_Formal (First_Formal (Id)))),
+ Lhs => Make_Identifier (Loc, Chars (Left)),
+ Rhs => Make_Identifier (Loc, Chars (Right)),
Bodies => Declarations (Decl))))));
Append (Decl, List_Containing (N));
-
- -- Handle renamings of predefined dispatching equality operators.
- -- When we analyze a renaming of the equality operator of a tagged
- -- type, the predefined dispatching primitives are not available
- -- (since they are added by the expander when the tagged type is
- -- frozen) and hence they are left decorated as renamings of the
- -- standard non-dispatching operators. Here we generate a body
- -- for such renamings which invokes the predefined dispatching
- -- equality operator.
-
- -- Example:
-
- -- type T is tagged null record;
- -- function Eq (X, Y : T1) return Boolean renames "=";
- -- function Neq (X, Y : T1) return Boolean renames "/=";
-
- elsif Is_Record_Type (Typ)
- and then Is_Tagged_Type (Typ)
- and then Is_Dispatching_Operation (Id)
- and then not Is_Dispatching_Operation (Entity (Nam))
- then
- pragma Assert (not Is_Frozen (Typ));
-
- Decl := Build_Body_For_Renaming;
-
- -- Clean decoration of intrinsic subprogram
-
- Set_Is_Intrinsic_Subprogram (Id, False);
- Set_Convention (Id, Convention_Ada);
-
- if Chars (Entity (Nam)) = Name_Op_Ne then
- Set_Handled_Statement_Sequence (Decl,
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (
- Make_Simple_Return_Statement (Loc,
- Expression =>
- Make_Op_Not (Loc,
- Make_Op_Eq (Loc,
- Left_Opnd =>
- New_Reference_To (Left, Loc),
- Right_Opnd =>
- New_Reference_To (Right, Loc)))))));
-
- else pragma Assert (Chars (Entity (Nam)) = Name_Op_Eq);
- Set_Handled_Statement_Sequence (Decl,
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (
- Make_Simple_Return_Statement (Loc,
- Expression =>
- Make_Op_Eq (Loc,
- Left_Opnd =>
- New_Reference_To (Left, Loc),
- Right_Opnd =>
- New_Reference_To (Right, Loc))))));
- end if;
-
- Append (Decl, List_Containing (N));
end if;
end;
end if;
if Token = Tok_Identifier then
Attr_Name := Token_Name;
- if not Is_Attribute_Name (Attr_Name) then
+ -- Note that the parser must complain in case of an internal
+ -- attribute names that comes from source since internal names
+ -- are meant to be used only by the compiler.
+
+ if not Is_Attribute_Name (Attr_Name)
+ or else (Is_Internal_Attribute_Name (Attr_Name)
+ and then Comes_From_Source (Token_Node))
+ then
Signal_Bad_Attribute;
end if;
elsif Token = Tok_Identifier then
Attr_Name := Token_Name;
- if not Is_Attribute_Name (Attr_Name) then
+ -- Note that internal attributes names don't denote real
+ -- attribute.
+
+ if not Is_Attribute_Name (Attr_Name)
+ or else Is_Internal_Attribute_Name (Attr_Name)
+ then
if Apostrophe_Should_Be_Semicolon then
Expr_Form := EF_Name;
return Name_Node;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop
- if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
+ -- No mispelling possible with internal attribute names since they
+ -- don't denote real attribute.
+
+ if not Is_Internal_Attribute_Name (Error_Msg_Name_1)
+ and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1)
+ then
Error_Msg_N -- CODEFIX
("\possible misspelling of %", Token_Node);
exit;
Attribute_Variable_Indexing =>
Error_Msg_N ("illegal attribute", N);
- -- Attributes related to Ada 2012 aspects. Attribute definition clause
- -- exists for these, but they cannot be queried.
+ -- Internal attributes used to deal with Ada 2012 delayed aspects
+ -- (already diagnosed by parser, thus nothing more to do here).
when Attribute_CPU |
Attribute_Dispatching_Domain |
Attribute_Interrupt_Priority =>
- Error_Msg_N ("illegal attribute", N);
+ raise Program_Error;
------------------
-- Abort_Signal --
-- Reject patently improper size values.
- if Is_Scalar_Type (T)
+ if Is_Elementary_Type (T)
and then Siz > UI_From_Int (Int'Last)
then
- Error_Msg_N ("Size value too large for scalar type", N);
+ Error_Msg_N ("Size value too large for elementary type", N);
if Nkind (Original_Node (N)) = N_Op_Expon then
Error_Msg_N
("\maybe '* was meant, rather than '*'*", Original_Node (N));
or else N not in Ada_2012_Reserved_Words);
end Is_Keyword_Name;
+ --------------------------------
+ -- Is_Internal_Attribute_Name --
+ --------------------------------
+
+ function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N = Name_CPU
+ or N = Name_Interrupt_Priority
+ or N = Name_Dispatching_Domain;
+ end Is_Internal_Attribute_Name;
+
----------------------------
-- Is_Locking_Policy_Name --
----------------------------
-- implementation dependent attributes may be found in the appropriate
-- section in Sem_Attr.
+ -- The entries marked INT are not real attributes. They are special names
+ -- used internally by GNAT in order to deal with delayed aspects
+ -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
+ -- don't have corresponding pragma or attribute.
+
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_Constrained : constant Name_Id := N + $;
Name_Count : constant Name_Id := N + $;
- Name_CPU : constant Name_Id := N + $; -- Ada 12
+ Name_CPU : constant Name_Id := N + $; -- INT
Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $;
Name_Denorm : constant Name_Id := N + $;
Name_Descriptor_Size : constant Name_Id := N + $;
Name_Digits : constant Name_Id := N + $;
- Name_Dispatching_Domain : constant Name_Id := N + $; -- Ada 12
+ Name_Dispatching_Domain : constant Name_Id := N + $; -- INT
Name_Elaborated : constant Name_Id := N + $; -- GNAT
Name_Emax : constant Name_Id := N + $; -- Ada 83
Name_Enabled : constant Name_Id := N + $; -- GNAT
Name_Img : constant Name_Id := N + $; -- GNAT
Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Integer_Value : constant Name_Id := N + $; -- GNAT
- Name_Interrupt_Priority : constant Name_Id := N + $; -- Ada 12
+ Name_Interrupt_Priority : constant Name_Id := N + $; -- INT
Name_Invalid_Value : constant Name_Id := N + $; -- GNAT
Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
Name_Large : constant Name_Id := N + $; -- Ada 83
-- Test to see if the name N is the name of a recognized entity attribute,
-- i.e. an attribute reference that returns an entity.
+ function Is_Internal_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of an INT attribute (Name_CPU,
+ -- Name_Dispatching_Domain, Name_Interrupt_Priority).
+
function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of a recognized attribute that
-- designates a procedure (and can therefore appear as a statement).
projects / gcc.git / commitdiff