+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
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));
-- 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 --
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,
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))
(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)
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
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;
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;
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
-- 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
end if;
Resolve_Actuals (N, Nam);
+ Check_Internal_Protected_Use (N, Nam);
-- Create a call reference to the entry
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 --
---------------------------------------
-- 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);
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;
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;
git://gcc.gnu.org / gcc.git / commitdiff