[multiple changes]

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb: Minor reformatting.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb (Check_Against_Predicate): Handle properly an
	others clause in various cases.

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Matching_Constituent): Do
	not inspect the hidden states if there are no hidden states. This
	case arises when the constituents are states coming from a
	private child.

2013-10-14  Doug Rupp  <rupp@adacore.com>

	* init.c [ARMEL and VxWorks] (__gnat_map_signal): Re-arm guard
	page by clearing VALID bit vice setting page protection.

2013-10-14  Arnaud Charlet  <charlet@adacore.com>

	* gnat_rm.texi, adaint.c: Fix typo.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_Variable, In_Protected_Function):  In the
	body of a protected function, the protected object itself is a
	constant (not just its components).

From-SVN: r203550

gcc/ada/ChangeLog

@@ -1,3 +1,34 @@
+2013-10-14  Robert Dewar  <dewar@adacore.com>
+
+	* exp_prag.adb: Minor reformatting.
+
+2013-10-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_case.adb (Check_Against_Predicate): Handle properly an
+	others clause in various cases.
+
+2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Check_Matching_Constituent): Do
+	not inspect the hidden states if there are no hidden states. This
+	case arises when the constituents are states coming from a
+	private child.
+
+2013-10-14  Doug Rupp  <rupp@adacore.com>
+
+	* init.c [ARMEL and VxWorks] (__gnat_map_signal): Re-arm guard
+	page by clearing VALID bit vice setting page protection.
+
+2013-10-14  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat_rm.texi, adaint.c: Fix typo.
+
+2013-10-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Is_Variable, In_Protected_Function):  In the
+	body of a protected function, the protected object itself is a
+	constant (not just its components).
+
 2013-10-14  Vincent Celier  <celier@adacore.com>
 
 	* snames.ads-tmpl: Add new standard name Library_Rpath_Options.

gcc/ada/adaint.c

@@ -3982,7 +3982,7 @@ __gnat_get_executable_load_address (void)
       status = loadquery (L_GETINFO, buf, blen);
       if (status == 0)
         {
-          struct ldinfo *info = (struct ld_info *)buf;
+          struct ld_info *info = (struct ld_info *)buf;
           return info->ldinfo_textorg;
         }
       blen = blen * 2;

gcc/ada/exp_prag.adb

@@ -543,30 +543,34 @@ package body Exp_Prag is
    -- Expand_Pragma_Import_Or_Interface --
    ---------------------------------------
 
-   --  When applied to a variable, the default initialization must not be done.
-   --  As it is already done when the pragma is found, we just get rid of the
-   --  call the initialization procedure which followed the object declaration.
-   --  The call is inserted after the declaration, but validity checks may
-   --  also have been inserted and the initialization call does not necessarily
-   --  appear immediately after the object declaration.
-
-   --  We can't use the freezing mechanism for this purpose, since we have to
-   --  elaborate the initialization expression when it is first seen (i.e. this
-   --  elaboration cannot be deferred to the freeze point).
-
    procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
       Def_Id    : Entity_Id;
       Init_Call : Node_Id;
 
    begin
       Def_Id := Entity (Arg2 (N));
+
+      --  Variable case
+
       if Ekind (Def_Id) = E_Variable then
 
+         --  When applied to a variable, the default initialization must not be
+         --  done. As it is already done when the pragma is found, we just get
+         --  rid of the call the initialization procedure which followed the
+         --  object declaration. The call is inserted after the declaration,
+         --  but validity checks may also have been inserted and thus the
+         --  initialization call does not necessarily appear immediately
+         --  after the object declaration.
+
+         --  We can't use the freezing mechanism for this purpose, since we
+         --  have to elaborate the initialization expression when it is first
+         --  seen (so this elaboration cannot be deferred to the freeze point).
+
          --  Find and remove generated initialization call for object, if any
 
          Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
 
-         --  Any default initialization expression should be removed (e.g.,
+         --  Any default initialization expression should be removed (e.g.
          --  null defaults for access objects, zero initialization of packed
          --  bit arrays). Imported objects aren't allowed to have explicit
          --  initialization, so the expression must have been generated by
@@ -575,19 +579,21 @@ package body Exp_Prag is
          if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
             Set_Expression (Parent (Def_Id), Empty);
          end if;
+
+      --  Case of exception with convention C++
+
       elsif Ekind (Def_Id) = E_Exception
         and then Convention (Def_Id) = Convention_CPP
       then
-
          --  Import a C++ convention
 
          declare
-            Loc            : constant Source_Ptr := Sloc (N);
+            Loc          : constant Source_Ptr := Sloc (N);
-            Exdata         : List_Id;
+            Rtti_Name    : constant Node_Id    := Arg3 (N);
-            Lang_Char      : Node_Id;
+            Dum          : constant Entity_Id  := Make_Temporary (Loc, 'D');
-            Foreign_Data   : Node_Id;
+            Exdata       : List_Id;
-            Rtti_Name      : constant Node_Id := Arg3 (N);
+            Lang_Char    : Node_Id;
-            Dum            : constant Entity_Id  := Make_Temporary (Loc, 'D');
+            Foreign_Data : Node_Id;
 
          begin
             Exdata := Component_Associations (Expression (Parent (Def_Id)));
@@ -598,9 +604,8 @@ package body Exp_Prag is
 
             Rewrite (Expression (Lang_Char),
               Make_Character_Literal (Loc,
-                Chars => Name_uC,
+                Chars              => Name_uC,
-                Char_Literal_Value =>
+                Char_Literal_Value => UI_From_Int (Character'Pos ('C'))));
-                  UI_From_Int (Character'Pos ('C'))));
             Analyze (Expression (Lang_Char));
 
             --  Change the value of Foreign_Data
@@ -633,6 +638,12 @@ package body Exp_Prag is
                   Attribute_Name => Name_Address)));
             Analyze (Expression (Foreign_Data));
          end;
+
+      --  No special expansion required for any other case
+
+      else
+         null;
+
       end if;
    end Expand_Pragma_Import_Or_Interface;
 

gcc/ada/gnat_rm.texi

@@ -18886,7 +18886,7 @@ pragma Import (Cpp,
   [External_Name =>] static_string_EXPRESSION);
 @end smallexample
 
-@noident
+@noindent
 The @code{External_Name} is the name of the C++ RTTI symbol. You can then
 cover a specific C++ exception in an exception handler.
 

gcc/ada/init.c

@@ -1663,6 +1663,10 @@ __gnat_install_handler ()
 #include <iv.h>
 #endif
 
+#if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6)
+#include <vmLib.h>
+#endif
+
 #ifdef VTHREADS
 #include "private/vThreadsP.h"
 #endif
@@ -1799,9 +1803,8 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
       msg = "unhandled signal";
     }
 
-  /* On ARM VxWorks 6.x, the guard page is left in a RWX state by the kernel
+  /* On ARM VxWorks 6.x, the guard page is left un-armed by the kernel
-     after being violated, so subsequent violations aren't detected.  Even if
+     after being violated, so subsequent violations aren't detected.
-     this defect is fixed, it seems dubious to rely on the signal value alone,
      so we retrieve the address of the guard page from the TCB and compare it
      with the page that is violated (pREG 12 in the context) and re-arm that
      page if there's a match.  Additionally we're are assured this is a
@@ -1809,28 +1812,22 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
      to that effect.  */
 #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6)
 
-  /* We re-arm the guard page by re-setting it's attributes, however the
+  /* We re-arm the guard page by marking it invalid */
-     protection bits are just the low order seven (0x3f).
-     0x00040 is the Valid Mask
-     0x00f00 are Cache attributes
-     0xff000 are Special attributes
-     We don't meddle with the 0xfff40 attributes.  */
 
 #define PAGE_SIZE 4096
-#define MMU_ATTR_PROT_MSK 0x0000003f /* Protection Mask.  */
+#define REG_IP 12
-#define GUARD_PAGE_PROT 0x8101       /* Found by experiment.  */
 
   if (sig == SIGSEGV || sig == SIGBUS || sig == SIGILL)
     {
       TASK_ID tid = taskIdSelf ();
       WIND_TCB *pTcb = taskTcb (tid);
-      unsigned long Violated_Page
+      unsigned long violated_page
-          = ((struct sigcontext *) sc)->sc_pregs->r[12] & ~(PAGE_SIZE - 1);
+          = ((struct sigcontext *) sc)->sc_pregs->r[REG_IP] & ~(PAGE_SIZE - 1);
 
-      if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == Violated_Page)
+      if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == violated_page)
         {
-	  vmStateSet (NULL, Violated_Page,
+	  vmStateSet (NULL, violated_page,
-		      PAGE_SIZE, MMU_ATTR_PROT_MSK, GUARD_PAGE_PROT);
+		      PAGE_SIZE, VM_STATE_MASK_VALID, VM_STATE_VALID_NOT);
 	  exception = &storage_error;
 
 	  switch (sig)

gcc/ada/sem_case.adb

@@ -319,8 +319,16 @@ package body Sem_Case is
          --                       ^ illegal ^
 
          elsif Pred_Lo < Choice_Lo and then Pred_Hi < Choice_Lo then
-            Missing_Choice (Pred_Lo, Pred_Hi);
+            if Others_Present then
-            Error := True;
+
+               --  Current predicate set is covered by others clause.
+
+               null;
+
+            else
+               Missing_Choice (Pred_Lo, Pred_Hi);
+               Error := True;
+            end if;
 
             --  There may be several static predicate sets between the current
             --  one and the choice. Inspect the next static predicate set.
@@ -384,7 +392,12 @@ package body Sem_Case is
             if Others_Present then
                Prev_Lo := Choice_Lo;
                Prev_Hi := Choice_Hi;
-               Next (Pred);
+
+               --  Check whether  predicate set is fully covered by choice
+
+               if Pred_Hi = Choice_Hi then
+                  Next (Pred);
+               end if;
 
             --  Choice_Lo   Choice_Hi   Pred_Hi
             --  +===========+===========+

gcc/ada/sem_prag.adb

@@ -21118,6 +21118,14 @@ package body Sem_Prag is
                   return;
                end if;
 
+               --  The related package has no hidden states, nothing to match.
+               --  This case arises when the constituents are states coming
+               --  from a private child.
+
+               if No (Hidden_States) then
+                  return;
+               end if;
+
                --  Inspect the hidden states of the related package looking for
                --  a match.
 

gcc/ada/sem_util.adb

@@ -10198,7 +10198,8 @@ package body Sem_Util is
       function In_Protected_Function (E : Entity_Id) return Boolean;
       --  Within a protected function, the private components of the enclosing
       --  protected type are constants. A function nested within a (protected)
-      --  procedure is not itself protected.
+      --  procedure is not itself protected. Within the body of a protected
+      --  function the current instance of the protected type is a constant.
 
       function Is_Variable_Prefix (P : Node_Id) return Boolean;
       --  Prefixes can involve implicit dereferences, in which case we must
@@ -10210,12 +10211,24 @@ package body Sem_Util is
       ---------------------------
 
       function In_Protected_Function (E : Entity_Id) return Boolean is
-         Prot : constant Entity_Id := Scope (E);
+         Prot : Entity_Id;
          S    : Entity_Id;
 
       begin
+         if Is_Type (E) then
+            --  E is the current instance of a type.
+
+            Prot := E;
+
+         else
+            --  E is an object.
+
+            Prot := Scope (E);
+         end if;
+
          if not Is_Protected_Type (Prot) then
             return False;
+
          else
             S := Current_Scope;
             while Present (S) and then S /= Prot loop
@@ -10336,9 +10349,14 @@ package body Sem_Util is
               or else  K = E_In_Out_Parameter
               or else  K = E_Generic_In_Out_Parameter
 
-               --  Current instance of type
+               --  Current instance of type. If this is a protected type, check
+               --  that we are not within the body of one of its protected
+               --  functions.
+
+              or else (Is_Type (E)
+                        and then In_Open_Scopes (E)
+                        and then not In_Protected_Function (E))
 
-              or else (Is_Type (E) and then In_Open_Scopes (E))
               or else (Is_Incomplete_Or_Private_Type (E)
                         and then In_Open_Scopes (Full_View (E)));
          end;