diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 36 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/validsw.adb | 10 |
10 files changed, 161 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6feb58d828c..c1b2ba3e5fd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2012-10-01 Robert Dewar <dewar@adacore.com> + + * make.adb, exp_ch3.adb: Minor reformatting. + +2012-10-01 Hristian Kirtchev <kirtchev@adacore.com> + + * validsw.adb (Save_Validity_Check_Options): Do not set + Validity_Check_Non_Overlapping_Params and + Validity_Check_Valid_Scalars_On_Params when -gnatVa is present + because the related checks are deemed too aggressive. + +2012-10-01 Ed Schonberg <schonberg@adacore.com> + + * sem_util.ads sem_util.adb (Check_Internal_Protected_Use): + reject use of protected procedure or entry within the body of + a protected function of the same protected type, when usage is + a call, an actual in an instantiation, a or prefix of 'Access. + * sem_ch8.adb (Analyze_Subprogram_Renaming): Verify that target + object in renaming of protected procedure is a variable, and + apply Check_Internal_Protected_Use. + * sem_res.adb (Analyze_Call, Analyze_Entry_Call): apply + Check_Internal_Protected_Use rather than on-line code. + * sem_attr.adb (Analyze_Access_Attribute): Verify that target + object in accsss to protected procedure is a variable, and apply + Check_Internal_Protected_Use. + +2012-10-01 Gary Dismukes <dismukes@adacore.com> + + * sem_ch4.adb (Find_Equality_Types.Try_One_Interp): Exclude the + predefined interpretation from consideration if it's for a "/=" + operator of a tagged type. This will allow Analyze_Equality_Op to + rewrite the "/=" as a logical negation of a call to the appropriate + dispatching equality function. This needs to be done during + analysis rather than expansion for the benefit of ASIS, which + otherwise gets the unresolved N_Op_Ne operator from Standard. + 2012-10-01 Thomas Quinot <quinot@adacore.com> * gnatcmd.adb, make.adb (Scan_Make_Arg, Inspect_Switches): Recognize diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index b43dfd82960..1059da6955b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4917,8 +4917,8 @@ package body Exp_Ch3 is and then not (Nkind (Object_Definition (N)) = N_Identifier - and then - Present (Equivalent_Type (Entity (Object_Definition (N))))) + and then + Present (Equivalent_Type (Entity (Object_Definition (N))))) then pragma Assert (Is_Class_Wide_Type (Typ)); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 2d53ee23fb5..33611d3a744 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -410,7 +410,7 @@ package body Make is -- Delete all temp files created by Gnatmake and call Osint.Fail, with the -- parameter S (see osint.ads). This is called from the Prj hierarchy and -- the MLib hierarchy. This subprogram also prints current error messages - -- (ie finalizes Errutil). + -- (i.e. finalizes Errutil). -------------------------- -- Obsolete Executables -- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 737ede23845..ccfaec3ef48 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -9003,6 +9003,21 @@ package body Sem_Attr is then Accessibility_Message; return; + + -- AI05-0225: If the context is not an access to protected + -- function, the prefix must be a variable, given that it may + -- be used subsequently in a protected call. + + elsif Nkind (P) = N_Selected_Component + and then not Is_Variable (Prefix (P)) + and then Ekind (Entity (Selector_Name (P))) /= E_Function + then + Error_Msg_N + ("target object of access to protected procedure " + & "must be variable", N); + + elsif Is_Entity_Name (P) then + Check_Internal_Protected_Use (N, Entity (P)); end if; elsif Ekind_In (Btyp, E_Access_Subprogram_Type, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 13430dbc4aa..6f157140123 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -5612,8 +5612,24 @@ package body Sem_Ch4 is return; end if; + -- If the right operand has a type compatible with T1, check for an + -- acceptable interpretation, unless T1 is limited (no predefined + -- equality available), or this is use of a "/=" for a tagged type. + -- In the latter case, possible interpretations of equality need to + -- be considered, we don't want the default inequality declared in + -- Standard to be chosen, and the "/=" will be rewritten as a + -- negation of "=" (see the end of Analyze_Equality_Op). This ensures + -- that that rewriting happens during analysis rather than being + -- delayed until expansion (this is needed for ASIS, which only sees + -- the unexpanded tree). Note that if the node is N_Op_Ne, but Op_Id + -- is Name_Op_Eq then we still proceed with the interpretation, + -- because that indicates the potential rewriting case where the + -- interpretation to consider is actually "=" and the node may be + -- about to be rewritten by Analyze_Equality_Op. + if T1 /= Standard_Void_Type and then Has_Compatible_Type (R, T1) + and then ((not Is_Limited_Type (T1) and then not Is_Limited_Composite (T1)) @@ -5622,6 +5638,11 @@ package body Sem_Ch4 is (Is_Array_Type (T1) and then not Is_Limited_Type (Component_Type (T1)) and then Available_Full_View_Of_Component (T1))) + + and then + (Nkind (N) /= N_Op_Ne + or else not Is_Tagged_Type (T1) + or else Chars (Op_Id) = Name_Op_Eq) then if Found and then Base_Type (T1) /= Base_Type (T_F) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index b4348c5bdbe..51772dba296 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1456,9 +1456,10 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Nam : constant Node_Id := Name (N); - Sel : constant Node_Id := Selector_Name (Nam); - Old_S : Entity_Id; + Nam : constant Node_Id := Name (N); + Sel : constant Node_Id := Selector_Name (Nam); + Is_Actual : constant Boolean := Present (Corresponding_Formal_Spec (N)); + Old_S : Entity_Id; begin if Entity (Sel) = Any_Id then @@ -1489,8 +1490,8 @@ package body Sem_Ch8 is Inherit_Renamed_Profile (New_S, Old_S); - -- The prefix can be an arbitrary expression that yields a task type, - -- so it must be resolved. + -- The prefix can be an arbitrary expression that yields a task or + -- protected object, so it must be resolved. Resolve (Prefix (Nam), Scope (Old_S)); end if; @@ -1498,6 +1499,24 @@ package body Sem_Ch8 is Set_Convention (New_S, Convention (Old_S)); Set_Has_Completion (New_S, Inside_A_Generic); + -- AI05-0225: If the renamed entity is a procedure or entry of a + -- protected object, the target object must be a variable. + + if Ekind (Scope (Old_S)) in Protected_Kind + and then Ekind (New_S) = E_Procedure + and then not Is_Variable (Prefix (Nam)) + then + if Is_Actual then + Error_Msg_N + ("target object of protected operation used as actual for " + & "formal procedure must be a variable", Nam); + else + Error_Msg_N + ("target object of protected operation renamed as procedure, " + & "must be a variable", Nam); + end if; + end if; + if Is_Body then Check_Frozen_Renaming (N, New_S); end if; @@ -2572,6 +2591,8 @@ package body Sem_Ch8 is Generate_Reference (Old_S, Nam); end if; + Check_Internal_Protected_Use (N, Old_S); + -- For a renaming-as-body, require subtype conformance, but if the -- declaration being completed has not been frozen, then inherit the -- convention of the renamed subprogram prior to checking conformance diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 21d3e145d33..c528047e634 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5314,15 +5314,7 @@ package body Sem_Res is -- Check that this is not a call to a protected procedure or entry from -- within a protected function. - if Ekind (Current_Scope) = E_Function - and then Ekind (Scope (Current_Scope)) = E_Protected_Type - and then Ekind (Nam) /= E_Function - and then Scope (Nam) = Scope (Current_Scope) - then - Error_Msg_N ("within protected function, protected " & - "object is constant", N); - Error_Msg_N ("\cannot call operation that may modify it", N); - end if; + Check_Internal_Protected_Use (N, Nam); -- Freeze the subprogram name if not in a spec-expression. Note that we -- freeze procedure calls as well as function calls. Procedure calls are @@ -6732,6 +6724,7 @@ package body Sem_Res is end if; Resolve_Actuals (N, Nam); + Check_Internal_Protected_Use (N, Nam); -- Create a call reference to the entry diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2dc7469b2f7..6d86d8b04bb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1191,6 +1191,50 @@ package body Sem_Util is end if; end Check_Implicit_Dereference; + ---------------------------------- + -- Check_Internal_Protected_Use -- + ---------------------------------- + + procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id) is + S : Entity_Id; + Prot : Entity_Id; + + begin + S := Current_Scope; + while Present (S) loop + if S = Standard_Standard then + return; + + elsif Ekind (S) = E_Function + and then Ekind (Scope (S)) = E_Protected_Type + then + Prot := Scope (S); + exit; + end if; + + S := Scope (S); + end loop; + + if Scope (Nam) = Prot and then Ekind (Nam) /= E_Function then + if Nkind (N) = N_Subprogram_Renaming_Declaration then + Error_Msg_N + ("within protected function cannot use protected " + & "procedure in renaming or as generic actual", N); + + elsif Nkind (N) = N_Attribute_Reference then + Error_Msg_N + ("within protected function cannot take access of " + & " protected procedure", N); + + else + Error_Msg_N + ("within protected function, protected object is constant", N); + Error_Msg_N + ("\cannot call operation that may modify it", N); + end if; + end if; + end Check_Internal_Protected_Use; + --------------------------------------- -- Check_Later_Vs_Basic_Declarations -- --------------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 8d1f7cfadb2..92377c931e7 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -170,6 +170,12 @@ package Sem_Util is -- checks whether T is a reference type, and if so it adds an interprettion -- to Expr whose type is the designated type of the reference_discriminant. + procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id); + -- Within a protected function, the current object is a constant, and + -- internal calls to a procedure or entry are illegal. Similarly, other + -- uses of a protected procedure in a renaming or a generic instantiation + -- in the context of a protected function are illegal (AI05-0225). + procedure Check_Later_Vs_Basic_Declarations (Decls : List_Id; During_Parsing : Boolean); diff --git a/gcc/ada/validsw.adb b/gcc/ada/validsw.adb index df39e1a568a..2edd0c09e38 100644 --- a/gcc/ada/validsw.adb +++ b/gcc/ada/validsw.adb @@ -214,6 +214,14 @@ package body Validsw is when 'V' => Validity_Check_Valid_Scalars_On_Params := False; + -- Note: The following two flags are not set when "-gnatVa" is in + -- effect because the associated checks are deemed too aggressive. + + -- Validity_Check_Non_Overlapping_Params + -- Validity_Check_Valid_Scalars_On_Params + + -- and in any case these do not belong as validity checks ??? + when 'a' => Validity_Check_Components := True; Validity_Check_Copies := True; @@ -221,13 +229,11 @@ package body Validsw is Validity_Check_Floating_Point := True; Validity_Check_In_Out_Params := True; Validity_Check_In_Params := True; - Validity_Check_Non_Overlapping_Params := True; Validity_Check_Operands := True; Validity_Check_Parameters := True; Validity_Check_Returns := True; Validity_Check_Subscripts := True; Validity_Check_Tests := True; - Validity_Check_Valid_Scalars_On_Params := True; when 'n' => Validity_Check_Components := False; |