Skip to content

R
riscv-gcc-1
Commit d48f3dca by Arnaud Charlet
Options

[multiple changes] 

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
parent 22a83cea
Showing with 89 additions and 80 deletions
gcc/ada/ChangeLog
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> 2012-07-09 Thomas Quinot <quinot@adacore.com>
* einfo.adb (Set_Reverse_Storage_Order): Update assertion, * einfo.adb (Set_Reverse_Storage_Order): Update assertion,
......
gcc/ada/exp_attr.adb
...@@ -835,13 +835,16 @@ package body Exp_Attr is ...@@ -835,13 +835,16 @@ package body Exp_Attr is
Attribute_Default_Iterator | Attribute_Default_Iterator |
Attribute_Implicit_Dereference | Attribute_Implicit_Dereference |
Attribute_Iterator_Element | 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 | when Attribute_CPU |
Attribute_Dispatching_Domain | Attribute_Dispatching_Domain |
Attribute_Interrupt_Priority => null; Attribute_Interrupt_Priority =>
raise Program_Error;
------------ ------------
-- Access -- -- Access --
......
gcc/ada/exp_ch8.adb
...@@ -300,8 +300,7 @@ package body Exp_Ch8 is ...@@ -300,8 +300,7 @@ package body Exp_Ch8 is
-- Handle cases where we build a body for a renamed equality -- Handle cases where we build a body for a renamed equality
if Is_Entity_Name (Nam) if Is_Entity_Name (Nam)
and then (Chars (Entity (Nam)) = Name_Op_Ne and then Chars (Entity (Nam)) = Name_Op_Eq
or else Chars (Entity (Nam)) = Name_Op_Eq)
and then Scope (Entity (Nam)) = Standard_Standard and then Scope (Entity (Nam)) = Standard_Standard
then then
declare declare
...@@ -315,7 +314,6 @@ package body Exp_Ch8 is ...@@ -315,7 +314,6 @@ package body Exp_Ch8 is
-- untagged record type (AI05-0123). -- untagged record type (AI05-0123).
if Ada_Version >= Ada_2012 if Ada_Version >= Ada_2012
and then Chars (Entity (Nam)) = Name_Op_Eq
and then Is_Record_Type (Typ) and then Is_Record_Type (Typ)
and then not Is_Tagged_Type (Typ) and then not Is_Tagged_Type (Typ)
and then not Is_Frozen (Typ) and then not Is_Frozen (Typ)
...@@ -337,71 +335,11 @@ package body Exp_Ch8 is ...@@ -337,71 +335,11 @@ package body Exp_Ch8 is
Expand_Record_Equality Expand_Record_Equality
(Id, (Id,
Typ => Typ, Typ => Typ,
Lhs => Lhs => Make_Identifier (Loc, Chars (Left)),
Make_Identifier (Loc, Chars (First_Formal (Id))), Rhs => Make_Identifier (Loc, Chars (Right)),
Rhs =>
Make_Identifier
(Loc, Chars (Next_Formal (First_Formal (Id)))),
Bodies => Declarations (Decl)))))); Bodies => Declarations (Decl))))));
Append (Decl, List_Containing (N)); 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 if;
end; end;
end if; end if;
......
gcc/ada/par-ch13.adb
...@@ -221,7 +221,14 @@ package body Ch13 is ...@@ -221,7 +221,14 @@ package body Ch13 is
if Token = Tok_Identifier then if Token = Tok_Identifier then
Attr_Name := Token_Name; 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; Signal_Bad_Attribute;
end if; end if;
......
gcc/ada/par-ch4.adb
...@@ -434,7 +434,12 @@ package body Ch4 is ...@@ -434,7 +434,12 @@ package body Ch4 is
elsif Token = Tok_Identifier then elsif Token = Tok_Identifier then
Attr_Name := Token_Name; 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 if Apostrophe_Should_Be_Semicolon then
Expr_Form := EF_Name; Expr_Form := EF_Name;
return Name_Node; return Name_Node;
......
gcc/ada/par-util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -721,7 +721,12 @@ package body Util is ...@@ -721,7 +721,12 @@ package body Util is
Error_Msg_Name_1 := First_Attribute_Name; Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop 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 Error_Msg_N -- CODEFIX
("\possible misspelling of %", Token_Node); ("\possible misspelling of %", Token_Node);
exit; exit;
......
gcc/ada/sem_attr.adb
...@@ -2215,13 +2215,13 @@ package body Sem_Attr is ...@@ -2215,13 +2215,13 @@ package body Sem_Attr is
Attribute_Variable_Indexing => Attribute_Variable_Indexing =>
Error_Msg_N ("illegal attribute", N); Error_Msg_N ("illegal attribute", N);
-- Attributes related to Ada 2012 aspects. Attribute definition clause -- Internal attributes used to deal with Ada 2012 delayed aspects
-- exists for these, but they cannot be queried. -- (already diagnosed by parser, thus nothing more to do here).
when Attribute_CPU | when Attribute_CPU |
Attribute_Dispatching_Domain | Attribute_Dispatching_Domain |
Attribute_Interrupt_Priority => Attribute_Interrupt_Priority =>
Error_Msg_N ("illegal attribute", N); raise Program_Error;
------------------ ------------------
-- Abort_Signal -- -- Abort_Signal --
......
gcc/ada/sem_ch13.adb
...@@ -7737,10 +7737,10 @@ package body Sem_Ch13 is ...@@ -7737,10 +7737,10 @@ package body Sem_Ch13 is
-- Reject patently improper size values. -- Reject patently improper size values.
if Is_Scalar_Type (T) if Is_Elementary_Type (T)
and then Siz > UI_From_Int (Int'Last) and then Siz > UI_From_Int (Int'Last)
then 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 if Nkind (Original_Node (N)) = N_Op_Expon then
Error_Msg_N Error_Msg_N
("\maybe '* was meant, rather than '*'*", Original_Node (N)); ("\maybe '* was meant, rather than '*'*", Original_Node (N));
......
gcc/ada/snames.adb-tmpl
...@@ -392,6 +392,17 @@ package body Snames is ...@@ -392,6 +392,17 @@ package body Snames is
or else N not in Ada_2012_Reserved_Words); or else N not in Ada_2012_Reserved_Words);
end Is_Keyword_Name; 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 -- -- Is_Locking_Policy_Name --
---------------------------- ----------------------------
......
gcc/ada/snames.ads-tmpl
...@@ -753,6 +753,11 @@ package Snames is ...@@ -753,6 +753,11 @@ package Snames is
-- implementation dependent attributes may be found in the appropriate -- implementation dependent attributes may be found in the appropriate
-- section in Sem_Attr. -- 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 -- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts. -- of GNAT, and are treated as illegal in all other contexts.
...@@ -779,7 +784,7 @@ package Snames is ...@@ -779,7 +784,7 @@ package Snames is
Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_Constrained : constant Name_Id := N + $; Name_Constrained : constant Name_Id := N + $;
Name_Count : 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_Bit_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Iterator : constant Name_Id := N + $; -- GNAT Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $; Name_Definite : constant Name_Id := N + $;
...@@ -787,7 +792,7 @@ package Snames is ...@@ -787,7 +792,7 @@ package Snames is
Name_Denorm : constant Name_Id := N + $; Name_Denorm : constant Name_Id := N + $;
Name_Descriptor_Size : constant Name_Id := N + $; Name_Descriptor_Size : constant Name_Id := N + $;
Name_Digits : 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_Elaborated : constant Name_Id := N + $; -- GNAT
Name_Emax : constant Name_Id := N + $; -- Ada 83 Name_Emax : constant Name_Id := N + $; -- Ada 83
Name_Enabled : constant Name_Id := N + $; -- GNAT Name_Enabled : constant Name_Id := N + $; -- GNAT
...@@ -809,7 +814,7 @@ package Snames is ...@@ -809,7 +814,7 @@ package Snames is
Name_Img : constant Name_Id := N + $; -- GNAT Name_Img : constant Name_Id := N + $; -- GNAT
Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Integer_Value : 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_Invalid_Value : constant Name_Id := N + $; -- GNAT
Name_Iterator_Element : constant Name_Id := N + $; -- GNAT Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
Name_Large : constant Name_Id := N + $; -- Ada 83 Name_Large : constant Name_Id := N + $; -- Ada 83
...@@ -1826,6 +1831,10 @@ package Snames is ...@@ -1826,6 +1831,10 @@ package Snames is
-- Test to see if the name N is the name of a recognized entity attribute, -- Test to see if the name N is the name of a recognized entity attribute,
-- i.e. an attribute reference that returns an entity. -- 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; 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 -- 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). -- designates a procedure (and can therefore appear as a statement).
......
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