From 66150d01351e5ca53999297629516ea2d5bcedb1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 25 Oct 2010 16:39:59 +0200 Subject: [PATCH] [multiple changes] 2010-10-25 Robert Dewar * sem_warn.adb, einfo.ads, exp_ch4.adb: Minor comment fix * sem_case.adb: Comment clarification for loops through false predicates. * sem_util.adb: Minor reformatting (Check_Order_Dependence): Fix bad double blank in error message 2010-10-25 Ed Schonberg * sem_ch4.adb (Analyze_Membership_Op): in Ada_2012 a membership operation can have a single alternative that is a value of the type. Rewrite operation as an equality test. From-SVN: r165918 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/einfo.ads | 3 ++- gcc/ada/exp_ch4.adb | 2 +- gcc/ada/sem_case.adb | 5 +++++ gcc/ada/sem_ch4.adb | 40 +++++++++++++++++++++++++++++++++------- gcc/ada/sem_util.adb | 35 ++++++++++++++++++++--------------- gcc/ada/sem_warn.adb | 4 ++-- 7 files changed, 77 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8e07f6d..40198cf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2010-10-25 Robert Dewar + + * sem_warn.adb, einfo.ads, exp_ch4.adb: Minor comment fix + * sem_case.adb: Comment clarification for loops through false + predicates. + * sem_util.adb: Minor reformatting + (Check_Order_Dependence): Fix bad double blank in error message + +2010-10-25 Ed Schonberg + + * sem_ch4.adb (Analyze_Membership_Op): in Ada_2012 a membership + operation can have a single alternative that is a value of the type. + Rewrite operation as an equality test. + 2010-10-25 Matthew Heaney * Makefile.rtl, impunit.adb: Added a-cobove (bounded vector container) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6b5a14a..851333d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3616,7 +3616,8 @@ package Einfo is -- entries sorted in ascending order, with all duplicates eliminated, -- and adjacent ranges coalesced, so that there is always a gap in the -- values between successive entries. The entries in this list are --- fully analyzed. +-- fully analyzed and typed with the base type of the subtype. Note +-- that all entries are static and have values within the subtype range. -- Storage_Size_Variable (Node15) [implementation base type only] -- Present in access types and task type entities. This flag is set diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 086e403..cfea0d6 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4369,7 +4369,7 @@ package body Exp_Ch4 is return Cond; end Make_Cond; - -- Start of processing for Expand_N_In + -- Start of processing for Expand_Set_Membership begin Alt := Last (Alternatives (N)); diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index fe97c6b..fd601c5 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -878,6 +878,11 @@ package body Sem_Case is C : Node_Id; begin + -- Loop through entries in predicate list, + -- converting to choices. Note that if the + -- list is empty, corresponding to a False + -- predicate, then no choices are inserted. + P := First (Static_Predicate (E)); while Present (P) loop C := New_Copy (P); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 45a4a21..8d8f776 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2276,8 +2276,9 @@ package body Sem_Ch4 is --------------------------- procedure Analyze_Membership_Op (N : Node_Id) is - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); + Loc : constant Source_Ptr := Sloc (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); Index : Interp_Index; It : Interp; @@ -2439,14 +2440,39 @@ package body Sem_Ch4 is end loop; end if; - -- If not a range, it can only be a subtype mark, or else there - -- is a more basic error, to be diagnosed in Find_Type. + -- If not a range, it can be a subtype mark, or else it is + -- a degenerate membership test with a singleton value, i.e. + -- a test for equality. else - Find_Type (R); - - if Is_Entity_Name (R) then + Analyze (R); + if Is_Entity_Name (R) + and then Is_Type (Entity (R)) + then + Find_Type (R); Check_Fully_Declared (Entity (R), R); + + elsif Ada_Version >= Ada_2012 then + if Nkind (N) = N_In then + Rewrite (N, + Make_Op_Eq (Loc, + Left_Opnd => L, + Right_Opnd => R)); + else + Rewrite (N, + Make_Op_Ne (Loc, + Left_Opnd => L, + Right_Opnd => R)); + end if; + + Analyze (N); + return; + + else + -- in previous version of the language this is an error + -- that will be diagnosed below. + + Find_Type (R); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7aca625..3850702 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1226,11 +1226,11 @@ package body Sem_Util is return; end if; - -- Ada2012 AI04-0144-2 : dangerous order dependence. - -- Actuals in nested calls within a construct have been collected. - -- If one of them is writeable and overlaps with another one, evaluation - -- of the enclosing construct is non-deterministic. - -- This is illegal in Ada2012, but is treated as a warning for now. + -- Ada 2012 AI04-0144-2 : dangerous order dependence. Actuals in nested + -- calls within a construct have been collected. If one of them is + -- writable and overlaps with another one, evaluation of the enclosing + -- construct is nondeterministic. This is illegal in Ada 2012, but is + -- treated as a warning for now. for J in 1 .. Actuals_In_Call.Last loop if Actuals_In_Call.Table (J).Is_Writable then @@ -1258,16 +1258,16 @@ package body Sem_Util is elsif Denotes_Same_Object (Act1, Act2) and then Parent (Act1) /= Parent (Act2) then - Error_Msg_N ( - "result may differ if evaluated " - & " after other actual in expression?", Act1); + Error_Msg_N + ("result may differ if evaluated " + & "after other actual in expression?", Act1); end if; end if; end loop; end if; end loop; - -- Remove checked actuals from table. + -- Remove checked actuals from table Actuals_In_Call.Set_Last (0); end Check_Order_Dependence; @@ -2366,9 +2366,13 @@ package body Sem_Util is Obj2 : Node_Id := A2; procedure Check_Renaming (Obj : in out Node_Id); - -- If an object is a renaming, examine renamed object. If is is a - -- dereference of a variable, or an indexed expression with non- - -- constant indices, no overlap check can be reported. + -- If an object is a renaming, examine renamed object. If it is a + -- dereference of a variable, or an indexed expression with non-constant + -- indexes, no overlap check can be reported. + + -------------------- + -- Check_Renaming -- + -------------------- procedure Check_Renaming (Obj : in out Node_Id) is begin @@ -2400,6 +2404,8 @@ package body Sem_Util is end if; end Check_Renaming; + -- Start of processing for Denotes_Same_Object + begin Check_Renaming (Obj1); Check_Renaming (Obj2); @@ -2449,8 +2455,7 @@ package body Sem_Util is Indx2 := First (Expressions (Obj2)); while Present (Indx1) loop - -- Indices must denote the same static value or the same - -- object. + -- Indexes must denote the same static value or same object if Is_OK_Static_Expression (Indx1) then if not Is_OK_Static_Expression (Indx2) then @@ -7989,7 +7994,7 @@ package body Sem_Util is -- Positional parameter for subprogram, entry, or accept call. -- In older versions of Ada function call arguments are never - -- lvalues. In Ada2012 functions can have in-out parameters. + -- lvalues. In Ada 2012 functions can have in-out parameters. when N_Function_Call | N_Procedure_Call_Statement | diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index da24d89..189750a 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3739,8 +3739,8 @@ package body Sem_Warn is elsif Nkind (Act2) = N_Function_Call then null; - -- If type is not by-copy we can assume that the aliasing - -- is intended. + -- If type is not by-copy we can assume that the aliasing is + -- intended. elsif Is_By_Reference_Type (Underlying_Type (Etype (Form1))) -- 2.7.4