+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.
-- 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;
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;
--------------------
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
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;
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;
- Next (Choice);
+
+ 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);
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);
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
-- 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;
(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,
-- 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
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)
(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)
-- Record type specific aspects
if Is_Record_Type (Typ) then
+
-- Bit_Order
if not Has_Rep_Item (Typ, Name_Bit_Order, False)
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;
------------------------------
-- 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
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 + $;
projects / thirdparty / gcc.git / commitdiff
