diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 56 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/sem_ch9.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 |
7 files changed, 108 insertions, 20 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6c8364d5bba..3ae01b7baa8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +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. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index bcfca25c6b0..d8df2a8f81d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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; -------------------- diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 993235210bb..e4c27d015ea 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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; - 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); @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index fff9bded522..02fb1131d1a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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) diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 6ee0bceeb81..d40647ed7ad 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -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; ------------------------------ diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 560d6c24b95..16e92cd60e9 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index d0c20153b0a..f4b31aa7996 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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 + $; |