mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 22:51:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_aggr.adb (Resolve_Record_Aggregate): In semantics-only mode treat an association with a box as providing a value...

Browse Source 
2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate): In semantics-only mode treat
	an association with a box as providing a value even though the
	initialization procedure for the type is not available.
	(Resolve_Record_Aggregate): Check that a choice of an association with a
	box corresponds to a component of the type.
	(Resolve_Record_Aggregate): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.

	* exp_tss.adb (Base_Init_Proc): Use Is_Type instead of Type_Kind for
	assert.

	* inline.adb (Add_Inlined_Body): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type. Make sure these are
	called only when appropriate.

From-SVN: r123569
This commit is contained in:
Ed Schonberg 2007-04-06 11:21:37 +02:00 committed by Arnaud Charlet
parent c5c7f76330
commit aad93b5537
3 changed files with 32 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/exp_tss.adb
View File

@ -44,7 +44,7 @@ package body Exp_Tss is
Proc : Entity_Id;
begin
pragma Assert (Ekind (Typ) in Type_Kind);
pragma Assert (Is_Type (Typ));
if Is_Private_Type (Typ) then
Full_Type := Underlying_Type (Base_Type (Typ));

2
gcc/ada/inline.adb
View File

@ -308,7 +308,7 @@ package body Inline is
-- no enclosing package to retrieve. In this case, it is the body of
-- the function that will have to be loaded.
if not Is_Abstract (E) and then not Is_Nested (E)
if not Is_Abstract_Subprogram (E) and then not Is_Nested (E)
and then Convention (E) /= Convention_Protected
then
Pack := Scope (E);

38
gcc/ada/sem_aggr.adb
View File

@ -2612,7 +2612,7 @@ package body Sem_Aggr is
-- STEP 1: abstract type and null record verification
if Is_Abstract (Typ) then
if Is_Abstract_Type (Typ) then
Error_Msg_N ("type of aggregate cannot be abstract", N);
end if;
@ -3000,7 +3000,9 @@ package body Sem_Aggr is
-- pass the component to the expander, which will generate
-- the call to such IP.
if Has_Non_Null_Base_Init_Proc (Ctyp) then
if Has_Non_Null_Base_Init_Proc (Ctyp)
or else not Expander_Active
then
Add_Association
(Component => Component,
Expr => Empty,
@ -3075,12 +3077,34 @@ package body Sem_Aggr is
end loop;
-- If no association, this is not a legal component of
-- of the type in question, except if this is an internal
-- component supplied by a previous expansion.
-- of the type in question, except if its association
-- is provided with a box.
if No (New_Assoc) then
if Box_Present (Parent (Selectr)) then
null;
-- This may still be a bogus component with a box. Scan
-- list of components to verify that a component with
-- that name exists.
declare
C : Entity_Id;
begin
C := First_Component (Typ);
while Present (C) loop
if Chars (C) = Chars (Selectr) then
exit;
end if;
Next_Component (C);
end loop;
if No (C) then
Error_Msg_Node_2 := Typ;
Error_Msg_N ("& is not a component of}", Selectr);
end if;
end;
elsif Chars (Selectr) /= Name_uTag
and then Chars (Selectr) /= Name_uParent
@ -3088,9 +3112,7 @@ package body Sem_Aggr is
then
if not Has_Discriminants (Typ) then
Error_Msg_Node_2 := Typ;
Error_Msg_N
("& is not a component of}",
Selectr);
Error_Msg_N ("& is not a component of}", Selectr);
else
Error_Msg_N
("& is not a component of the aggregate subtype",