sem_aggr.adb (Resolve_Record_Aggregate): In semantics-only mode treat an association...

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

diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb
index ad60e7a9bbde4230095477ed7d69dea200067c4e..65bf431033f1e8d007441fb26387b640062f9d4b 100644 (file)
--- a/gcc/ada/exp_tss.adb
+++ b/gcc/ada/exp_tss.adb
@@ -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));

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 3575d8f80a7eab65f3238716f45d18a1618245ce..f39bbbaf34483b0885947c9ff39b64c426bf3fc4 100644 (file)
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -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);

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 3ee19151372cfa71b16d6c3a965a620f7425ab36..4ca446cba80ac797bff1c7c6af009007b23d7918 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -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",