[multiple changes]

2010-10-18  Robert Dewar  <dewar@adacore.com>

	* g-trasym-vms-ia64.adb: Minor reformatting.

2010-10-18  Thomas Quinot  <quinot@adacore.com>

	* sem_type.adb (Covers): If either argument is Standard_Void_Type and
	the other isn't, return False early.

2010-10-18  Ed Falis  <falis@adacore.com>

	* s-vxwext-rtp.ads, s-vxext-rtp.adb: Adapt for missing APIs for RTPs in
	VxWorks Cert.

2010-10-18  Robert Dewar  <dewar@adacore.com>

	* sem_disp.ads: Minor comment update.

2010-10-18  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Spec_PPC_List): Is now present in Entries
	* sem_ch3.adb (Analyze_Declarations): Add processing for delaying
	visibility analysis of precondition and postcondition pragmas (and
	Pre/Post aspects).
	* sem_ch6.adb (Process_PPCs): Add handling of inherited Pre'Class
	aspects.
	* sem_ch7.adb (Analyze_Package_Specification): Remove special handling
	of pre/post conditions (no longer needed).
	* sem_disp.adb (Inherit_Subprograms): Deal with interface case.
	* sem_prag.adb (Analyze_PPC_In_Decl_Part): Remove analysis of message
	argument, since this is now done in the main processing for
	pre/postcondition pragmas when they are first seen.
	(Chain_PPC): Pre'Class and Post'Class now handled properly
	(Chain_PPC): Handle Pre/Post aspects for entries
	(Check_Precondition_Postcondition): Handle entry declaration case
	(Check_Precondition_Postcondition): Handle delay of visibility analysis
	(Check_Precondition_Postcondition): Preanalyze message argument if
	present.

From-SVN: r165612

gcc/ada/ChangeLog

 2010-10-18  Robert Dewar  <dewar@adacore.com>
 
+	* g-trasym-vms-ia64.adb: Minor reformatting.
+
+2010-10-18  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_type.adb (Covers): If either argument is Standard_Void_Type and
+	the other isn't, return False early.
+
+2010-10-18  Ed Falis  <falis@adacore.com>
+
+	* s-vxwext-rtp.ads, s-vxext-rtp.adb: Adapt for missing APIs for RTPs in
+	VxWorks Cert.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* sem_disp.ads: Minor comment update.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads, einfo.adb (Spec_PPC_List): Is now present in Entries
+	* sem_ch3.adb (Analyze_Declarations): Add processing for delaying
+	visibility analysis of precondition and postcondition pragmas (and
+	Pre/Post aspects).
+	* sem_ch6.adb (Process_PPCs): Add handling of inherited Pre'Class
+	aspects.
+	* sem_ch7.adb (Analyze_Package_Specification): Remove special handling
+	of pre/post conditions (no longer needed).
+	* sem_disp.adb (Inherit_Subprograms): Deal with interface case.
+	* sem_prag.adb (Analyze_PPC_In_Decl_Part): Remove analysis of message
+	argument, since this is now done in the main processing for
+	pre/postcondition pragmas when they are first seen.
+	(Chain_PPC): Pre'Class and Post'Class now handled properly
+	(Chain_PPC): Handle Pre/Post aspects for entries
+	(Check_Precondition_Postcondition): Handle entry declaration case
+	(Check_Precondition_Postcondition): Handle delay of visibility analysis
+	(Check_Precondition_Postcondition): Preanalyze message argument if
+	present.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
 	* g-trasym-vms-ia64.adb, prj-nmsc.adb, prj.ads: Minor reformatting.
 
 2010-10-14  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/einfo.adb

@@ -2581,7 +2581,10 @@ package body Einfo is
 
    function Spec_PPC_List (Id : E) return N is
    begin
-      pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
+      pragma Assert
+        (Ekind (Id) = E_Entry
+          or else Is_Subprogram (Id)
+          or else Is_Generic_Subprogram (Id));
       return Node24 (Id);
    end Spec_PPC_List;
 
@@ -5046,7 +5049,10 @@ package body Einfo is
 
    procedure Set_Spec_PPC_List (Id : E; V : N) is
    begin
-      pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
+      pragma Assert
+        (Ekind_In (Id, E_Entry, E_Void)
+          or else Is_Subprogram (Id)
+          or else Is_Generic_Subprogram (Id));
       Set_Node24 (Id, V);
    end Set_Spec_PPC_List;
 

gcc/ada/einfo.ads

@@ -3532,11 +3532,12 @@ package Einfo is
 --       the corresponding parameter entities in the spec.
 
 --    Spec_PPC_List (Node24)
---       Present in subprogram and generic subprogram entities. Points to a
---       list of Precondition and Postcondition pragma nodes for preconditions
---       and postconditions declared in the spec. The last pragma encountered
---       is at the head of this list, so it is in reverse order of textual
---       appearance.
+--       Present in entries, and in subprogram and generic subprogram entities.
+--       Points to a list of Precondition and Postcondition pragma nodes for
+--       preconditions and postconditions declared in the spec. The last pragma
+--       encountered is at the head of this list, so it is in reverse order of
+--       textual appearance. Note that this includes precondition/postcondition
+--       pragmas generated to correspond to Pre/Post aspects.
 
 --    Storage_Size_Variable (Node15) [implementation base type only]
 --       Present in access types and task type entities. This flag is set
@@ -4951,6 +4952,7 @@ package Einfo is
    --    Accept_Address                      (Elist21)
    --    Scope_Depth_Value                   (Uint22)
    --    Protection_Object                   (Node23)   (protected kind)
+   --    Spec_PPC_List                       (Node24)   (for entry only)
    --    Default_Expressions_Processed       (Flag108)
    --    Entry_Accepted                      (Flag152)
    --    Is_AST_Entry                        (Flag132)  (for entry only)

gcc/ada/g-trasym-vms-ia64.adb

@@ -325,7 +325,7 @@ package body GNAT.Traceback.Symbolic is
                Len := Last;
             end;
 
-         --  Even status values
+         --  Failure (bit 0 clear)
 
          else
             Res (Len + 1 .. Len + 6) := "ERROR" & ASCII.LF;

gcc/ada/s-vxwext-rtp.adb

@@ -26,7 +26,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides vxworks specific support functions needed
+--  This package provides VxWorks specific support functions needed
 --  by System.OS_Interface.
 
 --  This is the VxWorks 6 RTP version of this package
@@ -90,6 +90,17 @@ package body System.VxWorks.Ext is
       return 0;
    end Interrupt_Number_To_Vector;
 
+   ---------------
+   -- semDelete --
+   ---------------
+
+   function semDelete (Sem : SEM_ID) return int is
+      function OS_semDelete (Sem : SEM_ID) return int;
+      pragma Import (C, OS_semDelete, "semDelete");
+   begin
+      return OS_semDelete (Sem);
+   end semDelete;
+
    --------------------
    -- Set_Time_Slice --
    --------------------

gcc/ada/s-vxwext-rtp.ads

@@ -69,7 +69,7 @@ package System.VxWorks.Ext is
    pragma Convention (C, Interrupt_Number_To_Vector);
 
    function semDelete (Sem : SEM_ID) return int;
-   pragma Import (C, semDelete, "semDelete");
+   pragma Convention (C, semDelete);
 
    function Task_Cont (tid : t_id) return int;
    pragma Import (C, Task_Cont, "taskResume");

gcc/ada/sem_ch3.adb

@@ -62,6 +62,7 @@ with Sem_Dist; use Sem_Dist;
 with Sem_Elim; use Sem_Elim;
 with Sem_Eval; use Sem_Eval;
 with Sem_Mech; use Sem_Mech;
+with Sem_Prag; use Sem_Prag;
 with Sem_Res;  use Sem_Res;
 with Sem_Smem; use Sem_Smem;
 with Sem_Type; use Sem_Type;
@@ -2069,6 +2070,35 @@ package body Sem_Ch3 is
 
          D := Next_Node;
       end loop;
+
+      --  One more thing to do, we need to scan the declarations to check
+      --  for any precondition/postcondition pragmas (Pre/Post aspects have
+      --  by this stage been converted into corresponding pragmas). It is
+      --  at this point that we analyze the expressions in such pragmas,
+      --  to implement the delayed visibility requirement.
+
+      declare
+         Decl : Node_Id;
+         Spec : Node_Id;
+         Sent : Entity_Id;
+         Prag : Node_Id;
+
+      begin
+         Decl := First (L);
+         while Present (Decl) loop
+            if Nkind (Original_Node (Decl)) = N_Subprogram_Declaration then
+               Spec := Specification (Original_Node (Decl));
+               Sent := Defining_Unit_Name (Spec);
+               Prag := Spec_PPC_List (Sent);
+               while Present (Prag) loop
+                  Analyze_PPC_In_Decl_Part (Prag, Sent);
+                  Prag := Next_Pragma (Prag);
+               end loop;
+            end if;
+
+            Next (Decl);
+         end loop;
+      end;
    end Analyze_Declarations;
 
    -----------------------------------

gcc/ada/sem_ch6.adb

@@ -8699,18 +8699,22 @@ package body Sem_Ch6 is
          --  do this fiddling, for the spec cases, the already preanalyzed
          --  parameters are not affected.
 
+         Set_Analyzed (CP, False);
+
+         --  We also make sure Comes_From_Source is False for the copy
+
+         Set_Comes_From_Source (CP, False);
+
          --  For a postcondition pragma within a generic, preserve the pragma
          --  for later expansion.
 
-         Set_Analyzed (CP, False);
-
          if Nam = Name_Postcondition
            and then not Expander_Active
          then
             return CP;
          end if;
 
-         --  Change pragma into corresponding pragma Check
+         --  Change copy of pragma into corresponding pragma Check
 
          Prepend_To (Pragma_Argument_Associations (CP),
            Make_Pragma_Argument_Association (Sloc (Prag),
@@ -8761,9 +8765,8 @@ package body Sem_Ch6 is
 
          Prag := Spec_PPC_List (Spec_Id);
          while Present (Prag) loop
-            if Pragma_Name (Prag) = Name_Precondition
-              and then Pragma_Enabled (Prag)
-            then
+            if Pragma_Name (Prag) = Name_Precondition then
+
                --  For Pre (or Precondition pragma), we simply prepend the
                --  pragma to the list of declarations right away so that it
                --  will be executed at the start of the procedure. Note that
@@ -8969,7 +8972,6 @@ package body Sem_Ch6 is
                Prag := Spec_PPC_List (Spec);
                loop
                   if Pragma_Name (Prag) = Name_Postcondition
-                    and then Pragma_Enabled (Prag)
                     and then (not Class or else Class_Present (Prag))
                   then
                      if Plist = No_List then

gcc/ada/sem_ch7.adb

@@ -55,7 +55,6 @@ with Sem_Ch12; use Sem_Ch12;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Disp; use Sem_Disp;
 with Sem_Eval; use Sem_Eval;
-with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
 with Snames;   use Snames;
@@ -872,12 +871,6 @@ package body Sem_Ch7 is
       --  private_with_clauses, and remove them at the end of the nested
       --  package.
 
-      procedure Analyze_PPCs (Decls : List_Id);
-      --  Given a list of declarations, go through looking for subprogram
-      --  specs, and for each one found, analyze any pre/postconditions that
-      --  are chained to the spec. This is the implementation of the late
-      --  visibility analysis for preconditions and postconditions in specs.
-
       procedure Clear_Constants (Id : Entity_Id; FE : Entity_Id);
       --  Clears constant indications (Never_Set_In_Source, Constant_Value, and
       --  Is_True_Constant) on all variables that are entities of Id, and on
@@ -906,33 +899,6 @@ package body Sem_Ch7 is
       --  private part rather than being done in Sem_Ch12.Install_Parent
       --  (which is where the parents' visible declarations are installed).
 
-      ------------------
-      -- Analyze_PPCs --
-      ------------------
-
-      procedure Analyze_PPCs (Decls : List_Id) is
-         Decl : Node_Id;
-         Spec : Node_Id;
-         Sent : Entity_Id;
-         Prag : Node_Id;
-
-      begin
-         Decl := First (Decls);
-         while Present (Decl) loop
-            if Nkind (Original_Node (Decl)) = N_Subprogram_Declaration then
-               Spec := Specification (Original_Node (Decl));
-               Sent := Defining_Unit_Name (Spec);
-               Prag := Spec_PPC_List (Sent);
-               while Present (Prag) loop
-                  Analyze_PPC_In_Decl_Part (Prag, Sent);
-                  Prag := Next_Pragma (Prag);
-               end loop;
-            end if;
-
-            Next (Decl);
-         end loop;
-      end Analyze_PPCs;
-
       ---------------------
       -- Clear_Constants --
       ---------------------
@@ -1161,7 +1127,6 @@ package body Sem_Ch7 is
    begin
       if Present (Vis_Decls) then
          Analyze_Declarations (Vis_Decls);
-         Analyze_PPCs (Vis_Decls);
       end if;
 
       --  Verify that incomplete types have received full declarations
@@ -1296,7 +1261,6 @@ package body Sem_Ch7 is
          end if;
 
          Analyze_Declarations (Priv_Decls);
-         Analyze_PPCs (Priv_Decls);
 
          --  Check the private declarations for incomplete deferred constants
 

gcc/ada/sem_disp.adb

@@ -1742,8 +1742,29 @@ package body Sem_Disp is
       Parent_Op : Entity_Id;
       --  Traverses the Overridden_Operation chain
 
+      procedure Store_IS (E : Entity_Id);
+      --  Stores E in Result if not already stored
+
+      --------------
+      -- Store_IS --
+      --------------
+
+      procedure Store_IS (E : Entity_Id) is
+      begin
+         for J in 1 .. N loop
+            if E = Result (J) then
+               return;
+            end if;
+         end loop;
+
+         N := N + 1;
+         Result (N) := E;
+      end Store_IS;
+
+   --  Start of processing for Inherited_Subprograms
+
    begin
-      if Present (S) then
+      if Present (S) and then Is_Dispatching_Operation (S) then
 
          --  Deal with direct inheritance
 
@@ -1755,13 +1776,56 @@ package body Sem_Disp is
             if Is_Subprogram (Parent_Op)
               or else Is_Generic_Subprogram (Parent_Op)
             then
-               N := N + 1;
-               Result (N) := Parent_Op;
+               Store_IS (Parent_Op);
             end if;
          end loop;
 
-         --  For now don't bother with interfaces, TBD ???
+         --  Now deal with interfaces
+
+         declare
+            Tag_Typ : Entity_Id;
+            Prim    : Entity_Id;
+            Elmt    : Elmt_Id;
+
+         begin
+            Tag_Typ := Find_Dispatching_Type (S);
+
+            if Is_Concurrent_Type (Tag_Typ) then
+               Tag_Typ := Corresponding_Record_Type (Tag_Typ);
+            end if;
 
+            --  Search primitive operations of dispatching type
+
+            if Present (Tag_Typ)
+              and then Present (Primitive_Operations (Tag_Typ))
+            then
+               Elmt := First_Elmt (Primitive_Operations (Tag_Typ));
+               while Present (Elmt) loop
+                  Prim := Node (Elmt);
+
+                  --  The following test eliminates some odd cases in which
+                  --  Ekind (Prim) is Void, to be investigated further ???
+
+                  if not (Is_Subprogram (Prim)
+                            or else
+                          Is_Generic_Subprogram (Prim))
+                  then
+                     null;
+
+                     --  For [generic] subprogram, look at interface alias
+
+                  elsif Present (Interface_Alias (Prim))
+                    and then Alias (Prim) = S
+                  then
+                     --  We have found a primitive covered by S
+
+                     Store_IS (Interface_Alias (Prim));
+                  end if;
+
+                  Next_Elmt (Elmt);
+               end loop;
+            end if;
+         end;
       end if;
 
       return Result (1 .. N);

gcc/ada/sem_disp.ads

@@ -76,8 +76,9 @@ package Sem_Disp is
    --  and Empty if it is not dynamically tagged.
 
    function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id;
-   --  Check whether a subprogram is dispatching, and find the tagged
-   --  type of the controlling argument or arguments.
+   --  Check whether a subprogram is dispatching, and find the tagged type of
+   --  the controlling argument or arguments. Returns Empty if Subp is not a
+   --  dispatching operation.
 
    function Find_Primitive_Covering_Interface
      (Tagged_Type : Entity_Id;

gcc/ada/sem_prag.adb

@@ -240,9 +240,7 @@ package body Sem_Prag is
    ------------------------------
 
    procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id) is
-      Arg1 : constant Node_Id :=
-               First (Pragma_Argument_Associations (N));
-      Arg2 : constant Node_Id := Next (Arg1);
+      Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
 
    begin
       --  Install formals and push subprogram spec onto scope stack so that we
@@ -257,13 +255,6 @@ package body Sem_Prag is
       Preanalyze_Spec_Expression
         (Get_Pragma_Arg (Arg1), Standard_Boolean);
 
-      --  If there is a message argument, analyze it the same way
-
-      if Present (Arg2) then
-         Preanalyze_Spec_Expression
-           (Get_Pragma_Arg (Arg2), Standard_String);
-      end if;
-
       --  Remove the subprogram from the scope stack now that the pre-analysis
       --  of the precondition/postcondition is done.
 
@@ -1511,8 +1502,7 @@ package body Sem_Prag is
                     ("pragma% cannot be applied to abstract subprogram");
 
                elsif Class_Present (N) then
-                  Error_Pragma
-                    ("aspect `%''Class` not implemented yet");
+                  null;
 
                else
                   Error_Pragma
@@ -1520,14 +1510,19 @@ package body Sem_Prag is
                end if;
 
             elsif not Nkind_In (PO, N_Subprogram_Declaration,
-                                    N_Generic_Subprogram_Declaration)
+                                    N_Generic_Subprogram_Declaration,
+                                    N_Entry_Declaration)
             then
                Pragma_Misplaced;
             end if;
 
-            --  Here if we have subprogram or generic subprogram declaration
+            --  Here if we have [generic] subprogram or entry declaration
 
-            S := Defining_Unit_Name (Specification (PO));
+            if Nkind (PO) = N_Entry_Declaration then
+               S := Defining_Entity (PO);
+            else
+               S := Defining_Unit_Name (Specification (PO));
+            end if;
 
             --  Make sure we do not have the case of a precondition pragma when
             --  the Pre'Class aspect is present.
@@ -1583,14 +1578,11 @@ package body Sem_Prag is
                end;
             end if;
 
-            --  Analyze the pragma unless it appears within a package spec,
-            --  which is the case where we delay the analysis of the PPC until
-            --  the end of the package declarations (for details, see
-            --  Analyze_Package_Specification.Analyze_PPCs).
-
-            if not Is_Package_Or_Generic_Package (Scope (S)) then
-               Analyze_PPC_In_Decl_Part (N, S);
-            end if;
+            --  Note: we do not analye the pragma at this point. Instead we
+            --  delay this analysis until the end of the declarative part in
+            --  which the pragma appears. This implements the required delay
+            --  in this analysis, allowing forward references. The analysis
+            --  happens at the end of Analyze_Declarations.
 
             --  Chain spec PPC pragma to list for subprogram
 
@@ -1610,6 +1602,15 @@ package body Sem_Prag is
             Pragma_Misplaced;
          end if;
 
+         --  Preanalyze message argument if present. Visibility in this
+         --  argument is established at the point of pragma occurrence.
+
+         if Arg_Count = 2 then
+            Check_Optional_Identifier (Arg2, Name_Message);
+            Preanalyze_Spec_Expression
+              (Get_Pragma_Arg (Arg2), Standard_String);
+         end if;
+
          --  Record if pragma is enabled
 
          if Check_Enabled (Pname) then
@@ -10823,7 +10824,6 @@ package body Sem_Prag is
             Check_At_Least_N_Arguments (1);
             Check_At_Most_N_Arguments (2);
             Check_Optional_Identifier (Arg1, Name_Check);
-
             Check_Precondition_Postcondition (In_Body);
 
             --  If in spec, nothing more to do. If in body, then we convert the
@@ -10833,11 +10833,6 @@ package body Sem_Prag is
             --  analyze the condition itself in the proper context.
 
             if In_Body then
-               if Arg_Count = 2 then
-                  Check_Optional_Identifier (Arg3, Name_Message);
-                  Analyze_And_Resolve (Get_Pragma_Arg (Arg2), Standard_String);
-               end if;
-
                Rewrite (N,
                  Make_Pragma (Loc,
                    Chars => Name_Check,

gcc/ada/sem_type.adb

@@ -755,6 +755,14 @@ package body Sem_Type is
          end if;
       end if;
 
+      --  First check for Standard_Void_Type, which is special. Subsequent
+      --  processing in this routine assumes T1 and T2 are bona fide types;
+      --  Standard_Void_Type is a special entity that has some, but not all,
+      --  properties of types.
+
+      if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then
+         return False;
+
       --  Simplest case: same types are compatible, and types that have the
       --  same base type and are not generic actuals are compatible. Generic
       --  actuals  belong to their class but are not compatible with other
@@ -770,7 +778,7 @@ package body Sem_Type is
       --  the same actual, so that different subprograms end up with the same
       --  signature in the instance.
 
-      if T1 = T2 then
+      elsif T1 = T2 then
          return True;
 
       elsif BT1 = BT2