From 5c0e97dd35b7d16366bbae34539edff776f0b43c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 10:09:35 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Yannick Moy * sem_ch3.adb (Array_Type_Declaration): move test for type in ALFA after index creation; mark unconstrained base array type generated as being in/not in ALFA as well (Make_Index): mark subtype created as in/not in ALFA * sem_ch5.adb (Analyze_Iteration_Scheme): mark entity for iterating over a loop as in/not in ALFA, depending on its type and form of loop iteration. 2011-08-04 Hristian Kirtchev * exp_ch7.adb (Build_Object_Declarations): Initialize flag Abort directly to False on .NET and JVM. From-SVN: r177326 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/exp_ch7.adb | 8 ++++++-- gcc/ada/sem_ch3.adb | 26 ++++++++++++++++++++------ gcc/ada/sem_ch5.adb | 11 +++++++++++ 4 files changed, 52 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c4f4d47786e..aa77d3df316 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-08-04 Yannick Moy + + * sem_ch3.adb (Array_Type_Declaration): move test for type in ALFA + after index creation; mark unconstrained base array type generated as + being in/not in ALFA as well + (Make_Index): mark subtype created as in/not in ALFA + * sem_ch5.adb (Analyze_Iteration_Scheme): mark entity for iterating + over a loop as in/not in ALFA, depending on its type and form of loop + iteration. + +2011-08-04 Hristian Kirtchev + + * exp_ch7.adb (Build_Object_Declarations): Initialize flag Abort + directly to False on .NET and JVM. + 2011-08-04 Yannick Moy * sem_ch3.adb (Constrain_Enumeration, Constrain_Integer): remove diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 7f2496e1979..21a1ffea63a 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2817,7 +2817,9 @@ package body Exp_Ch7 is -- order to detect this scenario, save the state of entry into the -- finalization code. - if Abort_Allowed then + if Abort_Allowed + and then VM_Target = No_VM + then declare Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E'); @@ -2869,7 +2871,9 @@ package body Exp_Ch7 is Attribute_Name => Name_Identity))); end; - -- No abort + -- No abort or .NET/JVM. The VM version of Ada.Exceptions does not + -- include routine Raise_From_Controlled_Operation which is the sole + -- user of flag Abort. else A_Expr := New_Reference_To (Standard_False, Loc); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ec14ece6448..081b7fa10b0 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4678,12 +4678,6 @@ package body Sem_Ch3 is Check_SPARK_Restriction ("subtype mark required", Index); end if; - if Present (Etype (Index)) - and then not Is_In_ALFA (Etype (Index)) - then - T_In_ALFA := False; - end if; - -- Add a subtype declaration for each index of private array type -- declaration whose etype is also private. For example: @@ -4738,6 +4732,12 @@ package body Sem_Ch3 is Make_Index (Index, P, Related_Id, Nb_Index); + if Present (Etype (Index)) + and then not Is_In_ALFA (Etype (Index)) + then + T_In_ALFA := False; + end if; + -- Check error of subtype with predicate for index type Bad_Predicated_Subtype_Use @@ -4878,6 +4878,7 @@ package body Sem_Ch3 is Set_Component_Type (Base_Type (T), Element_Type); Set_Packed_Array_Type (T, Empty); Set_Is_In_ALFA (T, T_In_ALFA); + Set_Is_In_ALFA (Base_Type (T), T_In_ALFA); if Aliased_Present (Component_Definition (Def)) then Check_SPARK_Restriction @@ -16538,6 +16539,19 @@ package body Sem_Ch3 is then Set_Is_Non_Static_Subtype (Def_Id); end if; + + -- By default, consider that the subtype is in ALFA if its base type + -- is in ALFA. + + Set_Is_In_ALFA (Def_Id, Is_In_ALFA (Base_Type (Def_Id))); + + -- In ALFA, all subtypes should have a static range + + if Nkind (R) = N_Range + and then not Is_Static_Range (R) + then + Set_Is_In_ALFA (Def_Id, False); + end if; end if; -- Final step is to label the index with this constructed type diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 6283207cc51..239f9fe35bf 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2082,6 +2082,17 @@ package body Sem_Ch5 is Set_Etype (Id, Etype (DS)); end if; + -- The entity for iterating over a loop is always in ALFA if + -- its type is in ALFA, and it is not an iteration over + -- elements of a container using the OF syntax. + + if Is_In_ALFA (Etype (Id)) + and then (No (Iterator_Specification (N)) + or else not Of_Present (Iterator_Specification (N))) + then + Set_Is_In_ALFA (Id); + end if; + -- Treat a range as an implicit reference to the type, to -- inhibit spurious warnings. -- 2.30.2