* einfo.ads, einfo.adb (Is_Overriding_Operation): Removed.
(Set_Is_Overriding_Operation): Removed.
* sem_ch3.adb (Check_Abstract_Overriding): Remove redundant call to
Is_Overriding_Operation.
* exp_ch7.adb (Check_Visibly_Controlled): Remove redundant call to
Is_Overriding_Operation.
* sem_ch7.adb (Declare_Inherited_Private_Subprograms): Remove redundant
call to Set_Is_Overriding_Operation.
* sem_util.adb (Collect_Primitive_Operations): Replace test on
Is_Overriding_Operation by test on the presence of attribute
Overridden_Operation.
(Original_Corresponding_Operation): Remove redundant call to attribute
Is_Overriding_Operation.
* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Remove
redundant call to Is_Overriding_Operation.
(Verify_Overriding_Indicator): Replace several occurrences of test on
Is_Overriding_Operation by test on the presence of attribute
Overridden_Operation.
(Check_Convention): Replace test on Is_Overriding_Operation by test on
the presence of Overridden_Operation.
(Check_Overriding_Indicator): Add missing decoration of attribute
Overridden_Operation. Minor code cleanup.
(New_Overloaded_Entity): Replace occurrence of test on
Is_Overriding_Operation by test on the presence of attribute
Overridden_Operation. Remove redundant setting of attribute
Is_Overriding_Operation plus minor code reorganization.
Add missing decoration of attribute Overridden_Operation.
* sem_elim.adb (Set_Eliminated): Replace test on
Is_Overriding_Operation by test on the presence of Overridden_Operation.
* sem_ch8.adb (Analyze_Subprogram_Renaming): Replace test on
Is_Overriding_Operation by test on the presence of
Overridden_Operation. Remove a redundant test on attribute
Is_Overriding_Operation.
* lib-xref.adb (Generate_Reference): Replace test on
Is_Overriding_Operation by test on the presence of Overridden_Operation.
(Output_References): Replace test on Is_Overriding_Operation by test on
the presence of Overridden_Operation.
* sem_disp.adb (Override_Dispatching_Operation): Replace test on
Is_Overriding_Operation by test on the presence of Overridden_Operation.
Add missing decoration of attribute Overridden_Operation.
2010-10-26 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Properly check
RM 13.4.1(10).
2010-10-26 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Actuals): In case of certain
internally-generated type conversions (created by OK_Convert_To, so the
Conversion_OK flag is set), avoid fetching the component type when it's
not really an array type, but a private type completed by an array type.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165945
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-10-26 Javier Miranda <miranda@adacore.com>
+
+ * einfo.ads, einfo.adb (Is_Overriding_Operation): Removed.
+ (Set_Is_Overriding_Operation): Removed.
+ * sem_ch3.adb (Check_Abstract_Overriding): Remove redundant call to
+ Is_Overriding_Operation.
+ * exp_ch7.adb (Check_Visibly_Controlled): Remove redundant call to
+ Is_Overriding_Operation.
+ * sem_ch7.adb (Declare_Inherited_Private_Subprograms): Remove redundant
+ call to Set_Is_Overriding_Operation.
+ * sem_util.adb (Collect_Primitive_Operations): Replace test on
+ Is_Overriding_Operation by test on the presence of attribute
+ Overridden_Operation.
+ (Original_Corresponding_Operation): Remove redundant call to attribute
+ Is_Overriding_Operation.
+ * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Remove
+ redundant call to Is_Overriding_Operation.
+ (Verify_Overriding_Indicator): Replace several occurrences of test on
+ Is_Overriding_Operation by test on the presence of attribute
+ Overridden_Operation.
+ (Check_Convention): Replace test on Is_Overriding_Operation by test on
+ the presence of Overridden_Operation.
+ (Check_Overriding_Indicator): Add missing decoration of attribute
+ Overridden_Operation. Minor code cleanup.
+ (New_Overloaded_Entity): Replace occurrence of test on
+ Is_Overriding_Operation by test on the presence of attribute
+ Overridden_Operation. Remove redundant setting of attribute
+ Is_Overriding_Operation plus minor code reorganization.
+ Add missing decoration of attribute Overridden_Operation.
+ * sem_elim.adb (Set_Eliminated): Replace test on
+ Is_Overriding_Operation by test on the presence of Overridden_Operation.
+ * sem_ch8.adb (Analyze_Subprogram_Renaming): Replace test on
+ Is_Overriding_Operation by test on the presence of
+ Overridden_Operation. Remove a redundant test on attribute
+ Is_Overriding_Operation.
+ * lib-xref.adb (Generate_Reference): Replace test on
+ Is_Overriding_Operation by test on the presence of Overridden_Operation.
+ (Output_References): Replace test on Is_Overriding_Operation by test on
+ the presence of Overridden_Operation.
+ * sem_disp.adb (Override_Dispatching_Operation): Replace test on
+ Is_Overriding_Operation by test on the presence of Overridden_Operation.
+ Add missing decoration of attribute Overridden_Operation.
+
+2010-10-26 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Properly check
+ RM 13.4.1(10).
+
+2010-10-26 Bob Duff <duff@adacore.com>
+
+ * sem_res.adb (Resolve_Actuals): In case of certain
+ internally-generated type conversions (created by OK_Convert_To, so the
+ Conversion_OK flag is set), avoid fetching the component type when it's
+ not really an array type, but a private type completed by an array type.
+
2010-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb: Adjust format of error message.
-- Referenced_As_LHS Flag36
-- Is_Known_Non_Null Flag37
-- Can_Never_Be_Null Flag38
- -- Is_Overriding_Operation Flag39
-- Body_Needed_For_SAL Flag40
-- Treat_As_Volatile Flag41
-- Has_Inheritable_Invariants Flag248
-- Has_Predicates Flag250
+ -- (unused) Flag39
-- (unused) Flag151
-- (unused) Flag249
-- (unused) Flag251
return Flag134 (Id);
end Is_Optional_Parameter;
- function Is_Overriding_Operation (Id : E) return B is
- begin
- pragma Assert (Is_Subprogram (Id));
- return Flag39 (Id);
- end Is_Overriding_Operation;
-
function Is_Package_Body_Entity (Id : E) return B is
begin
return Flag160 (Id);
Set_Flag134 (Id, V);
end Set_Is_Optional_Parameter;
- procedure Set_Is_Overriding_Operation (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Subprogram (Id));
- Set_Flag39 (Id, V);
- end Set_Is_Overriding_Operation;
-
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
begin
Set_Flag160 (Id, V);
W ("Is_Obsolescent", Flag153 (Id));
W ("Is_Only_Out_Parameter", Flag226 (Id));
W ("Is_Optional_Parameter", Flag134 (Id));
- W ("Is_Overriding_Operation", Flag39 (Id));
W ("Is_Package_Body_Entity", Flag160 (Id));
W ("Is_Packed", Flag51 (Id));
W ("Is_Packed_Array_Type", Flag138 (Id));
-- Applies to all entities, true for ordinary fixed point types and
-- subtypes.
--- Is_Overriding_Operation (Flag39)
--- Present in subprograms. Set if the subprogram is a primitive
--- operation of a derived type, that overrides an inherited operation.
-
-- Is_Package_Or_Generic_Package (synthesized)
-- Applies to all entities. True for packages and generic packages.
-- False for all other entities.
-- Is_Instantiated (Flag126) (generic case only)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
- -- Is_Overriding_Operation (Flag39) (non-generic case only)
-- Is_Primitive (Flag218)
-- Is_Primitive_Wrapper (Flag195) (non-generic case only)
-- Is_Private_Descendant (Flag53)
-- First_Entity (Node17)
-- Alias (Node18)
-- Last_Entity (Node20)
+ -- Overridden_Operation (Node26)
-- Subprograms_For_Type (Node29)
-- Has_Invariants (Flag232)
-- Has_Postconditions (Flag240)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Pure (Flag44)
-- Is_Intrinsic_Subprogram (Flag64)
- -- Is_Overriding_Operation (Flag39)
-- Is_Primitive (Flag218)
-- Is_Thunk (Flag225)
-- Default_Expressions_Processed (Flag108)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
-- Is_Null_Init_Proc (Flag178)
- -- Is_Overriding_Operation (Flag39) (non-generic case only)
-- Is_Primitive (Flag218)
-- Is_Primitive_Wrapper (Flag195) (non-generic case only)
-- Is_Private_Descendant (Flag53)
function Is_Object (Id : E) return B;
function Is_Ordinary_Fixed_Point_Type (Id : E) return B;
function Is_Overloadable (Id : E) return B;
- function Is_Overriding_Operation (Id : E) return B;
function Is_Private_Type (Id : E) return B;
function Is_Protected_Type (Id : E) return B;
function Is_Real_Type (Id : E) return B;
procedure Set_Is_Obsolescent (Id : E; V : B := True);
procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True);
procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
- procedure Set_Is_Overriding_Operation (Id : E; V : B := True);
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
procedure Set_Is_Packed (Id : E; V : B := True);
procedure Set_Is_Packed_Array_Type (Id : E; V : B := True);
pragma Inline (Is_Package_Body_Entity);
pragma Inline (Is_Ordinary_Fixed_Point_Type);
pragma Inline (Is_Overloadable);
- pragma Inline (Is_Overriding_Operation);
pragma Inline (Is_Packed);
pragma Inline (Is_Packed_Array_Type);
pragma Inline (Is_Potentially_Use_Visible);
pragma Inline (Set_Is_Obsolescent);
pragma Inline (Set_Is_Only_Out_Parameter);
pragma Inline (Set_Is_Optional_Parameter);
- pragma Inline (Set_Is_Overriding_Operation);
pragma Inline (Set_Is_Package_Body_Entity);
pragma Inline (Set_Is_Packed);
pragma Inline (Set_Is_Packed_Array_Type);
begin
if Is_Derived_Type (Typ)
and then Comes_From_Source (E)
- and then not Is_Overriding_Operation (E)
+ and then not Present (Overridden_Operation (E))
then
-- We know that the explicit operation on the type does not override
-- the inherited operation of the parent, and that the derivation
if Typ = 'p'
and then Is_Subprogram (N)
- and then Is_Overriding_Operation (N)
+ and then Present (Overridden_Operation (N))
then
Xrefs.Table (Indx).Typ := 'P';
else
-- on operation that was overridden.
if Is_Subprogram (XE.Ent)
- and then Is_Overriding_Operation (XE.Ent)
+ and then Present (Overridden_Operation (XE.Ent))
then
Output_Overridden_Op (Overridden_Operation (XE.Ent));
end if;
declare
Fbit : constant Uint :=
Static_Integer (First_Bit (CC));
+ Lbit : constant Uint :=
+ Static_Integer (Last_Bit (CC));
begin
- -- Case of component with size > max machine scalar
+ -- Case of component with last bit >= max machine scalar
- if Esize (Comp) > Max_Machine_Scalar_Size then
+ if Lbit >= Max_Machine_Scalar_Size then
- -- Must begin on byte boundary
+ -- This is allowed only if first bit is zero, and
+ -- last bit + 1 is a multiple of storage unit size.
- if Fbit mod SSU /= 0 then
- Error_Msg_N
- ("illegal first bit value for "
- & "reverse bit order",
- First_Bit (CC));
- Error_Msg_Uint_1 := SSU;
- Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
+ if Fbit = 0 and then (Lbit + 1) mod SSU = 0 then
- Error_Msg_N
- ("\must be a multiple of ^ "
- & "if size greater than ^",
- First_Bit (CC));
+ -- This is the case to give a warning if enabled
- -- Must end on byte boundary
+ if Warn_On_Reverse_Bit_Order then
+ Error_Msg_N
+ ("multi-byte field specified with "
+ & " non-standard Bit_Order?", CC);
+
+ if Bytes_Big_Endian then
+ Error_Msg_N
+ ("\bytes are not reversed "
+ & "(component is big-endian)?", CC);
+ else
+ Error_Msg_N
+ ("\bytes are not reversed "
+ & "(component is little-endian)?", CC);
+ end if;
+ end if;
- elsif Esize (Comp) mod SSU /= 0 then
- Error_Msg_N
- ("illegal last bit value for "
- & "reverse bit order",
- Last_Bit (CC));
- Error_Msg_Uint_1 := SSU;
- Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
+ -- Give error message for RM 13.4.1(10) violation
- Error_Msg_N
- ("\must be a multiple of ^ if size "
- & "greater than ^",
- Last_Bit (CC));
+ else
+ Error_Msg_FE
+ ("machine scalar rules not followed for&",
+ First_Bit (CC), Comp);
- -- OK, give warning if enabled
+ Error_Msg_Uint_1 := Lbit;
+ Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
+ Error_Msg_F
+ ("\last bit (^) exceeds maximum machine "
+ & "scalar size (^)",
+ First_Bit (CC));
- elsif Warn_On_Reverse_Bit_Order then
- Error_Msg_N
- ("multi-byte field specified with "
- & " non-standard Bit_Order?", CC);
+ if (Lbit + 1) mod SSU /= 0 then
+ Error_Msg_Uint_1 := SSU;
+ Error_Msg_F
+ ("\and is not a multiple of Storage_Unit (^) "
+ & "('R'M 13.4.1(10))",
+ First_Bit (CC));
- if Bytes_Big_Endian then
- Error_Msg_N
- ("\bytes are not reversed "
- & "(component is big-endian)?", CC);
else
- Error_Msg_N
- ("\bytes are not reversed "
- & "(component is little-endian)?", CC);
+ Error_Msg_Uint_1 := Fbit;
+ Error_Msg_F
+ ("\and first bit (^) is non-zero "
+ & "('R'M 13.4.1(10))",
+ First_Bit (CC));
end if;
end if;
- -- Case where size is not greater than max machine
- -- scalar. For now, we just count these.
+ -- OK case of machine scalar related component clause,
+ -- For now, just count them.
else
Num_CC := Num_CC + 1;
-- Start of processing for Sort_CC
begin
- -- Collect the component clauses
+ -- Collect the machine scalar relevant component clauses
Num_CC := 0;
Comp := First_Component_Or_Discriminant (R);
while Present (Comp) loop
- if Present (Component_Clause (Comp))
- and then Esize (Comp) <= Max_Machine_Scalar_Size
- then
- Num_CC := Num_CC + 1;
- Comps (Num_CC) := Comp;
- end if;
+ declare
+ CC : constant Node_Id := Component_Clause (Comp);
+
+ begin
+ -- Collect only component clauses whose last bit is less
+ -- than machine scalar size. Any component clause whose
+ -- last bit exceeds this value does not take part in
+ -- machine scalar layout considerations. The test for
+ -- Error_Posted makes sure we exclude component clauses
+ -- for which we already posted an error.
+
+ if Present (CC)
+ and then not Error_Posted (Last_Bit (CC))
+ and then Static_Integer (Last_Bit (CC)) <
+ Max_Machine_Scalar_Size
+ then
+ Num_CC := Num_CC + 1;
+ Comps (Num_CC) := Comp;
+ end if;
+ end;
Next_Component_Or_Discriminant (Comp);
end loop;
-- primitive marked with pragma Implemented.
if Ada_Version >= Ada_2012
- and then Is_Overriding_Operation (Subp)
and then Present (Overridden_Operation (Subp))
and then Has_Rep_Pragma
(Overridden_Operation (Subp), Name_Implemented)
elsif Warn_On_Redundant_Constructs
and then not Is_Dispatching_Operation (Designator)
- and then not Is_Overriding_Operation (Designator)
+ and then not Present (Overridden_Operation (Designator))
and then (not Is_Operator_Symbol_Name (Chars (Designator))
or else Scop /= Scope (Etype (First_Formal (Designator))))
then
then
null;
- elsif not Is_Overriding_Operation (Spec_Id) then
+ elsif not Present (Overridden_Operation (Spec_Id)) then
Error_Msg_NE
("subprogram& is not overriding", Body_Spec, Spec_Id);
end if;
elsif Must_Not_Override (Body_Spec) then
- if Is_Overriding_Operation (Spec_Id) then
+ if Present (Overridden_Operation (Spec_Id)) then
Error_Msg_NE
("subprogram& overrides inherited operation",
Body_Spec, Spec_Id);
end if;
elsif Style_Check -- ??? incorrect use of Style_Check!
- and then Is_Overriding_Operation (Spec_Id)
+ and then Present (Overridden_Operation (Spec_Id))
then
pragma Assert (Unit_Declaration_Node (Body_Id) = N);
Style.Missing_Overriding (N, Body_Id);
Error_Msg_Sloc := Sloc (Op);
if Comes_From_Source (Op) or else No (Alias (Op)) then
- if not Is_Overriding_Operation (Op) then
+ if not Present (Overridden_Operation (Op)) then
Error_Msg_N ("\\primitive % defined #", Typ);
else
Error_Msg_N
end if;
elsif Is_Subprogram (Subp) then
- Set_Is_Overriding_Operation (Subp);
+ Set_Overridden_Operation (Subp, Overridden_Subp);
end if;
-- If primitive flag is set or this is a protected operation, then
end if;
elsif Must_Override (Spec) then
- if Is_Overriding_Operation (Subp) then
- null;
-
- elsif not Can_Override then
+ if No (Overridden_Operation (Subp))
+ and then not Can_Override
+ then
Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
end if;
not Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Subp)))
then
- Set_Is_Overriding_Operation (Subp);
-
-- If style checks are enabled, indicate that the indicator is
-- missing. However, at the point of declaration, the type of
-- which this is a primitive operation may be private, in which
if Ada_Version >= Ada_2012
and then No (Overridden_Subp)
and then Is_Dispatching_Operation (S)
- and then Is_Overriding_Operation (S)
+ and then Present (Overridden_Operation (S))
then
Overridden_Subp := Overridden_Operation (S);
end if;
Check_Operation_From_Private_View (S, E);
end if;
- -- In any case the implicit operation remains hidden by
- -- the existing declaration, which is overriding.
+ -- In any case the implicit operation remains hidden by the
+ -- existing declaration, which is overriding. Indicate that
+ -- E overrides the operation from which S is inherited.
- Set_Is_Overriding_Operation (E);
+ if Present (Alias (S)) then
+ Set_Overridden_Operation (E, Alias (S));
+ else
+ Set_Overridden_Operation (E, S);
+ end if;
if Comes_From_Source (E) then
Check_Overriding_Indicator (E, S, Is_Primitive => False);
-
- -- Indicate that E overrides the operation from which
- -- S is inherited.
-
- if Present (Alias (S)) then
- Set_Overridden_Operation (E, Alias (S));
- else
- Set_Overridden_Operation (E, S);
- end if;
end if;
return;
if No (Next_Entity (Prev)) then
Set_Last_Entity (Current_Scope, Prev);
end if;
-
end if;
end if;
Enter_Overloaded_Entity (S);
- Set_Is_Overriding_Operation (S);
+ Set_Overridden_Operation (S, E);
Check_Overriding_Indicator (S, E, Is_Primitive => True);
-- If S is a user-defined subprogram or a null procedure
-- expanded to override an inherited null procedure, or a
-- predefined dispatching primitive then indicate that E
- -- overrides the operation from which S is inherited. It
- -- seems odd that Overridden_Operation isn't set in all
- -- cases where Is_Overriding_Operation is true, but doing
- -- so causes infinite loops in the compiler for implicit
- -- overriding subprograms. ???
+ -- overrides the operation from which S is inherited.
if Comes_From_Source (S)
or else
then
if Present (Alias (E)) then
Set_Overridden_Operation (S, Alias (E));
- else
- Set_Overridden_Operation (S, E);
end if;
end if;
New_Op := Node (Op_Elmt_2);
Replace_Elmt (Op_Elmt, New_Op);
Remove_Elmt (Op_List, Op_Elmt_2);
- Set_Is_Overriding_Operation (New_Op);
Set_Overridden_Operation (New_Op, Parent_Subp);
-- We don't need to inherit its dispatching slot.
-- Ada 2005: check overriding indicator
- if Is_Overriding_Operation (Rename_Spec) then
+ if Present (Overridden_Operation (Rename_Spec)) then
if Must_Not_Override (Specification (N)) then
Error_Msg_NE
("subprogram& overrides inherited operation",
and then No (DTC_Entity (Old_S))
and then Present (Alias (Old_S))
and then not Is_Abstract_Subprogram (Alias (Old_S))
- and then Is_Overriding_Operation (Alias (Old_S))
+ and then Present (Overridden_Operation (Alias (Old_S)))
then
Old_S := Alias (Old_S);
end if;
-- New_Stream_Subprogram)
if Present (Old_Subp)
- and then Is_Overriding_Operation (Subp)
+ and then Present (Overridden_Operation (Subp))
and then Is_Dispatching_Operation (Old_Subp)
then
pragma Assert
and then Is_Controlled (Tagged_Type)
and then not Is_Visibly_Controlled (Tagged_Type)
then
- Set_Is_Overriding_Operation (Subp, False);
+ Set_Overridden_Operation (Subp, Empty);
-- If the subprogram specification carries an overriding
-- indicator, no need for the warning: it is either redundant,
else
Override_Dispatching_Operation (Tagged_Type, Ovr_Subp, Subp);
- Set_Is_Overriding_Operation (Subp);
-- Ada 2005 (AI-251): In case of late overriding of a primitive
-- that covers abstract interface subprograms we must register it
-- If an overriding dispatching primitive is eliminated then
-- its parent must have been eliminated.
- if Is_Overriding_Operation (E)
+ if Present (Overridden_Operation (E))
and then not Is_Eliminated (Overridden_Operation (E))
then
Error_Msg_Name_1 := Chars (E);
if Ekind (F) = E_In_Out_Parameter
and then Is_Array_Type (Etype (F))
then
- if Has_Aliased_Components (Etype (Expression (A)))
- /= Has_Aliased_Components (Etype (F))
- then
-
- -- In a view conversion, the conversion must be legal in
- -- both directions, and thus both component types must be
- -- aliased, or neither (4.6 (8)).
+ -- In a view conversion, the conversion must be legal in
+ -- both directions, and thus both component types must be
+ -- aliased, or neither (4.6 (8)).
- -- The additional rule 4.6 (24.9.2) seems unduly
- -- restrictive: the privacy requirement should not apply
- -- to generic types, and should be checked in an
- -- instance. ARG query is in order ???
+ -- The extra rule in 4.6 (24.9.2) seems unduly restrictive:
+ -- the privacy requirement should not apply to generic
+ -- types, and should be checked in an instance. ARG query
+ -- is in order ???
+ if Has_Aliased_Components (Etype (Expression (A))) /=
+ Has_Aliased_Components (Etype (F))
+ then
Error_Msg_N
("both component types in a view conversion must be"
& " aliased, or neither", A);
+ -- Comment here??? what set of cases???
+
elsif
not Same_Ancestor (Etype (F), Etype (Expression (A)))
then
+ -- Check view conv between unrelated by ref array types
+
if Is_By_Reference_Type (Etype (F))
or else Is_By_Reference_Type (Etype (Expression (A)))
then
Error_Msg_N
("view conversion between unrelated by reference " &
"array types not allowed (\'A'I-00246)", A);
- else
+
+ -- In Ada 2005 mode, check view conversion component
+ -- type cannot be private, tagged, or volatile. Note
+ -- that we only apply this to source conversions. The
+ -- generated code can contain conversions which are
+ -- not subject to this test, and we cannot extract the
+ -- component type in such cases since it is not present.
+
+ elsif Comes_From_Source (A)
+ and then Ada_Version >= Ada_2005
+ then
declare
Comp_Type : constant Entity_Id :=
Component_Type
(Etype (Expression (A)));
begin
- if Comes_From_Source (A)
- and then Ada_Version >= Ada_2005
- and then
- ((Is_Private_Type (Comp_Type)
- and then not Is_Generic_Type (Comp_Type))
- or else Is_Tagged_Type (Comp_Type)
- or else Is_Volatile (Comp_Type))
+ if (Is_Private_Type (Comp_Type)
+ and then not Is_Generic_Type (Comp_Type))
+ or else Is_Tagged_Type (Comp_Type)
+ or else Is_Volatile (Comp_Type)
then
Error_Msg_N
("component type of a view conversion cannot"
end if;
end if;
+ -- Resolve expression if conversion is all OK
+
if (Conversion_OK (A)
- or else Valid_Conversion (A, Etype (A), Expression (A)))
+ or else Valid_Conversion (A, Etype (A), Expression (A)))
and then not Is_Ref_To_Bit_Packed_Array (Expression (A))
then
Resolve (Expression (A));
if Chars (Id) = Name_Op_Eq
and then Is_Dispatching_Operation (Id)
and then Present (Alias (Id))
- and then Is_Overriding_Operation (Alias (Id))
+ and then Present (Overridden_Operation (Alias (Id)))
and then Base_Type (Etype (First_Entity (Id))) =
Base_Type (Etype (First_Entity (Alias (Id))))
then
-- If S overrides an inherted subprogram S2 the original corresponding
-- operation of S is the original corresponding operation of S2
- elsif Is_Overriding_Operation (S)
- and then Present (Overridden_Operation (S))
- then
+ elsif Present (Overridden_Operation (S)) then
return Original_Corresponding_Operation (Overridden_Operation (S));
-- otherwise it is S itself
OSDN Git Service
