Commit 2791be24 by Arnaud Charlet

[multiple changes]

2012-10-01  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads, exp_aggr.adb, sem_ch13.adb: Minor reformatting.

2012-10-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Array_Aggregate): Handle properly
	component associations given by subtypes that have static
	predicates.  Improve error message for overlapping ranges in
	array aggregates.

2012-10-01  Pascal Obry  <obry@adacore.com>

	* snames.ads-tmpl (Name_Link_Lib_Subdir): New constant.

2012-10-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch9.adb (Analyze_Requeue): The target of a requeue
	statement on a protected entry must be a variable. This is part
	of AI05-0225.

From-SVN: r191889
parent f686b370
2012-10-01 Robert Dewar <dewar@adacore.com>
* sinfo.ads, exp_aggr.adb, sem_ch13.adb: Minor reformatting.
2012-10-01 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): Handle properly
component associations given by subtypes that have static
predicates. Improve error message for overlapping ranges in
array aggregates.
2012-10-01 Pascal Obry <obry@adacore.com>
* snames.ads-tmpl (Name_Link_Lib_Subdir): New constant.
2012-10-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb (Analyze_Requeue): The target of a requeue
statement on a protected entry must be a variable. This is part
of AI05-0225.
2012-09-26 Ian Lance Taylor <iant@google.com>
* gcc-interface/Makefile.in (LIBBACKTRACE): New variable.
......
......@@ -239,12 +239,13 @@ package body Exp_Aggr is
-- N is the N_Aggregate node to be expanded.
function Is_Two_Dim_Packed_Array (Typ : Entity_Id) return Boolean;
-- For two-dimensional packed aggregates with constant bounds and constant
-- components, it is preferable to pack the inner aggregates because the
-- whole matrix can then be presented to the back-end as a one-dimensional
-- list of literals. This is much more efficient than expanding into single
-- component assignments.
-- component assignments. This function determines if the type Typ is for
-- an array that is suitable for this optimization: it returns True if Typ
-- is a two dimensional bit packed array with component size 1, 2, or 4.
function Late_Expansion
(N : Node_Id;
......@@ -5924,8 +5925,7 @@ package body Exp_Aggr is
begin
return Number_Dimensions (Typ) = 2
and then Is_Bit_Packed_Array (Typ)
and then
(C = 1 or else C = 2 or else C = 4);
and then (C = 1 or else C = 2 or else C = 4);
end Is_Two_Dim_Packed_Array;
--------------------
......
......@@ -1726,6 +1726,9 @@ package body Sem_Aggr is
Discard : Node_Id;
pragma Warnings (Off, Discard);
Delete_Choice : Boolean;
-- Used when replacing a subtype choice with predicate by a list
Aggr_Low : Node_Id := Empty;
Aggr_High : Node_Id := Empty;
-- The actual low and high bounds of this sub-aggregate
......@@ -1766,6 +1769,8 @@ package body Sem_Aggr is
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
Choice := First (Choices (Assoc));
Delete_Choice := False;
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
Others_Present := True;
......@@ -1792,10 +1797,56 @@ package body Sem_Aggr is
Error_Msg_N
("(Ada 83) illegal context for OTHERS choice", N);
end if;
elsif Is_Entity_Name (Choice) then
Analyze (Choice);
declare
E : constant Entity_Id := Entity (Choice);
New_Cs : List_Id;
P : Node_Id;
C : Node_Id;
begin
if Is_Type (E) and then Has_Predicates (E) then
Freeze_Before (N, E);
-- If the subtype has a static predicate, replace the
-- original choice with the list of individual values
-- covered by the predicate.
if Present (Static_Predicate (E)) then
Delete_Choice := True;
New_Cs := New_List;
P := First (Static_Predicate (E));
while Present (P) loop
C := New_Copy (P);
Set_Sloc (C, Sloc (Choice));
Append_To (New_Cs, C);
Next (P);
end loop;
Insert_List_After (Choice, New_Cs);
end if;
end if;
end;
end if;
Nb_Choices := Nb_Choices + 1;
declare
C : constant Node_Id := Choice;
begin
Next (Choice);
if Delete_Choice then
Remove (C);
Nb_Choices := Nb_Choices - 1;
Delete_Choice := False;
end if;
end;
end loop;
Next (Assoc);
......@@ -1998,6 +2049,7 @@ package body Sem_Aggr is
Nb_Discrete_Choices := Nb_Discrete_Choices + 1;
Table (Nb_Discrete_Choices).Choice_Lo := Low;
Table (Nb_Discrete_Choices).Choice_Hi := High;
Table (Nb_Discrete_Choices).Choice_Node := Choice;
Next (Choice);
......@@ -2115,7 +2167,7 @@ package body Sem_Aggr is
then
Error_Msg_N
("duplicate choice values in array aggregate",
Table (J).Choice_Hi);
Table (J).Choice_Node);
return Failure;
elsif not Others_Present then
......
......@@ -856,7 +856,7 @@ package body Sem_Ch13 is
-- Start of processing for Analyze_Aspects_At_Freeze_Point
begin
-- Must be visible in current scope.
-- Must be visible in current scope
if not Scope_Within_Or_Same (Current_Scope, Scope (E)) then
return;
......@@ -7966,18 +7966,20 @@ package body Sem_Ch13 is
(Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item;
-- Start of processing for Inherit_Aspects_At_Freeze_Point
begin
-- A representation item is either subtype-specific (Size and Alignment
-- clauses) or type-related (all others). Subtype-specific aspects may
-- differ for different subtypes of the same type.(RM 13.1.8)
-- differ for different subtypes of the same type (RM 13.1.8).
-- A derived type inherits each type-related representation aspect of
-- its parent type that was directly specified before the declaration of
-- the derived type. (RM 13.1.15)
-- the derived type (RM 13.1.15).
-- A derived subtype inherits each subtype-specific representation
-- aspect of its parent subtype that was directly specified before the
-- declaration of the derived type .(RM 13.1.15)
-- declaration of the derived type (RM 13.1.15).
-- The general processing involves inheriting a representation aspect
-- from a parent type whenever the first rep item (aspect specification,
......@@ -7986,11 +7988,11 @@ package body Sem_Ch13 is
-- directly specified to Typ but to one of its parents.
-- ??? Note that, for now, just a limited number of representation
-- aspects have been inherited here so far. Many of them are still
-- inherited in Sem_Ch3. This will be fixed soon. Here is a
-- non-exhaustive list of aspects that likely also need to be moved to
-- this routine: Alignment, Component_Alignment, Component_Size,
-- Machine_Radix, Object_Size, Pack, Predicates,
-- aspects have been inherited here so far. Many of them are
-- still inherited in Sem_Ch3. This will be fixed soon. Here is
-- a non- exhaustive list of aspects that likely also need to
-- be moved to this routine: Alignment, Component_Alignment,
-- Component_Size, Machine_Radix, Object_Size, Pack, Predicates,
-- Preelaborable_Initialization, RM_Size and Small.
if Nkind (Parent (Typ)) = N_Private_Extension_Declaration then
......@@ -8029,7 +8031,7 @@ package body Sem_Ch13 is
Set_Is_Volatile (Typ);
end if;
-- Default_Component_Value.
-- Default_Component_Value
if Is_Array_Type (Typ)
and then Has_Rep_Item (Typ, Name_Default_Component_Value, False)
......@@ -8040,7 +8042,7 @@ package body Sem_Ch13 is
(Entity (Get_Rep_Item (Typ, Name_Default_Component_Value))));
end if;
-- Default_Value.
-- Default_Value
if Is_Scalar_Type (Typ)
and then Has_Rep_Item (Typ, Name_Default_Value, False)
......@@ -8135,6 +8137,7 @@ package body Sem_Ch13 is
-- Record type specific aspects
if Is_Record_Type (Typ) then
-- Bit_Order
if not Has_Rep_Item (Typ, Name_Bit_Order, False)
......
......@@ -2379,6 +2379,18 @@ package body Sem_Ch9 is
end;
end if;
end if;
-- AI05-0225: the target protected object of a requeue must be a
-- variable. This is a binding interpretation that applies to all
-- versions of the language.
if Present (Target_Obj)
and then Ekind (Scope (Entry_Id)) in Protected_Kind
and then not Is_Variable (Target_Obj)
then
Error_Msg_N
("target protected object of requeue must be a variable", N);
end if;
end Analyze_Requeue;
------------------------------
......
......@@ -668,9 +668,8 @@ package Sinfo is
-- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Present in N_Aggregate nodes. Set for aggregates which can be fully
-- evaluated at compile time without raising constraint error. Such
-- aggregates can be passed as is to Gigi without any expansion. See
-- Exp_Aggr for the specific conditions under which an aggregate has this
-- flag set.
-- aggregates can be passed as is the back end without any expansion.
-- See Exp_Aggr for specific conditions under which this flag gets set.
-- Componentwise_Assignment (Flag14-Sem)
-- Present in N_Assignment_Statement nodes. Set for a record assignment
......
......@@ -1208,6 +1208,7 @@ package Snames is
Name_Leading_Required_Switches : constant Name_Id := N + $;
Name_Leading_Switches : constant Name_Id := N + $;
Name_Lib_Subdir : constant Name_Id := N + $;
Name_Link_Lib_Subdir : constant Name_Id := N + $;
Name_Library : constant Name_Id := N + $;
Name_Library_Ali_Dir : constant Name_Id := N + $;
Name_Library_Auto_Init : constant Name_Id := N + $;
......
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