[multiple changes]

2015-02-20  Arnaud Charlet  <charlet@adacore.com>

	* sysdep.c, expect.c, s-oscons-tmplt.c, gsocket.h, adaint.c: Remove
	obsolete references to RTX, nucleus, VMS.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Fix_Error): For an illegal Type_Invariant'Class
	aspect, use name that mentions Class explicitly, rather than
	compiler-internal name.

2015-02-20  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Add documentation for -gnatd.2 (allow statements
	in decl sequences).
	* par-ch3.adb (P_Identifier_Declarations): Handle
	statement appearing where declaration expected more cleanly.
	(Statement_When_Declaration_Expected): Implement debug flag
	-gnatd.2.

2015-02-20  Jose Ruiz  <ruiz@adacore.com>

	* a-dinopr.ads: Add spec for this package (Unimplemented_Unit).
	* a-dispat.ads (Yield): Include procedure added in Ada 2012.
	* a-dispat.adb (Yield): Implement procedure added in Ada 2012.
	* impunit.adb (Non_Imp_File_Names_05): Mark unit a-dinopr.ads as
	defined by Ada 2005.
	* snames.ads-tmpl (Name_Non_Preemptive_FIFO_Within_Priorities):
	This is the correct name for the dispatching policy (FIFO was
	missing).

2015-02-20  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion): If the type of the
	operand is the limited-view of a class-wide type then recover
	the class-wide type of the non-limited view.

From-SVN: r220852

gcc/ada/ChangeLog

 2015-02-20  Arnaud Charlet  <charlet@adacore.com>
 
+	* sysdep.c, expect.c, s-oscons-tmplt.c, gsocket.h, adaint.c: Remove
+	obsolete references to RTX, nucleus, VMS.
+
+2015-02-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Fix_Error): For an illegal Type_Invariant'Class
+	aspect, use name that mentions Class explicitly, rather than
+	compiler-internal name.
+
+2015-02-20  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: Add documentation for -gnatd.2 (allow statements
+	in decl sequences).
+	* par-ch3.adb (P_Identifier_Declarations): Handle
+	statement appearing where declaration expected more cleanly.
+	(Statement_When_Declaration_Expected): Implement debug flag
+	-gnatd.2.
+
+2015-02-20  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-dinopr.ads: Add spec for this package (Unimplemented_Unit).
+	* a-dispat.ads (Yield): Include procedure added in Ada 2012.
+	* a-dispat.adb (Yield): Implement procedure added in Ada 2012.
+	* impunit.adb (Non_Imp_File_Names_05): Mark unit a-dinopr.ads as
+	defined by Ada 2005.
+	* snames.ads-tmpl (Name_Non_Preemptive_FIFO_Within_Priorities):
+	This is the correct name for the dispatching policy (FIFO was
+	missing).
+
+2015-02-20  Javier Miranda  <miranda@adacore.com>
+
+	* sem_res.adb (Resolve_Type_Conversion): If the type of the
+	operand is the limited-view of a class-wide type then recover
+	the class-wide type of the non-limited view.
+
+2015-02-20  Arnaud Charlet  <charlet@adacore.com>
+
 	* gcc-interface/Makefile.in: Remove references to nucleus.
 	* gcc-interface/decl.c (gnat_to_gnu_entity, case E_Procedure): Set
 	extern_flag to true for Inline_Always subprograms with

gcc/ada/a-dinopr.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--       A D A . D I S P A T C H I N G . N O N _ P R E E M P T I V E        --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This unit is not implemented in typical GNAT implementations that lie on
+--  top of operating systems, because it is infeasible to implement in such
+--  environments.
+
+--  If a target environment provides appropriate support for this package,
+--  then the Unimplemented_Unit pragma should be removed from this spec and
+--  an appropriate body provided.
+
+package Ada.Dispatching.Non_Preemptive is
+   pragma Preelaborate (Non_Preemptive);
+
+   pragma Unimplemented_Unit;
+
+   procedure Yield_To_Higher;
+   procedure Yield_To_Same_Or_Higher renames Yield;
+end Ada.Dispatching.Non_Preemptive;

gcc/ada/a-dispat.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                       A D A . D I S P A T C H I N G                      --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2015, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Exceptions;
+with System.Tasking;
+with System.Task_Primitives.Operations;
+
+package body Ada.Dispatching is
+
+   procedure Yield is
+      Self_Id : constant System.Tasking.Task_Id :=
+         System.Task_Primitives.Operations.Self;
+
+   begin
+      --  If pragma Detect_Blocking is active, Program_Error must be
+      --  raised if this potentially blocking operation is called from a
+      --  protected action.
+
+      if System.Tasking.Detect_Blocking
+        and then Self_Id.Common.Protected_Action_Nesting > 0
+      then
+         Ada.Exceptions.Raise_Exception
+           (Program_Error'Identity, "potentially blocking operation");
+      else
+         System.Task_Primitives.Operations.Yield;
+      end if;
+   end Yield;
+
+end Ada.Dispatching;

gcc/ada/a-dispat.ads

@@ -14,7 +14,9 @@
 ------------------------------------------------------------------------------
 
 package Ada.Dispatching is
-   pragma Pure (Dispatching);
+   pragma Preelaborate (Dispatching);
+
+   procedure Yield;
 
    Dispatching_Policy_Error : exception;
 end Ada.Dispatching;

gcc/ada/debug.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -155,8 +155,8 @@ package body Debug is
    --  d8   Force opposite endianness in packed stuff
    --  d9   Allow lock free implementation
 
-   --  d.1
-   --  d.2
+   --  d.1  Enable unnesting of nested procedures
+   --  d.2  Allow statements in declarative part
    --  d.3
    --  d.4
    --  d.5
@@ -746,6 +746,14 @@ package body Debug is
    --  d9   This allows lock free implementation for protected objects
    --       (see Exp_Ch9).
 
+   --  d.1  Enable unnesting of nested procedures. This special pass does not
+   --       actually unnest things, but it ensures that a nested procedure
+   --       does not contain any uplevel references.
+
+   --  d.2  Allow statements within declarative parts. This is not usually
+   --       allowed, but in some debugging contexts (e.g. testing the circuit
+   --       for unnesting of procedures), it is useful to allow this.
+
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
    ------------------------------------------

gcc/ada/expect.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *                     Copyright (C) 2001-2014, AdaCore                     *
+ *                     Copyright (C) 2001-2015, AdaCore                     *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -54,8 +54,8 @@
   /* ??? See comment in adaint.c.  */
 # define GCC_RESOURCE_H
 # include <sys/wait.h>
-#elif defined (__nucleus__) || defined (__PikeOS__)
-  /* No wait.h available on Nucleus */
+#elif defined (__PikeOS__)
+  /* No wait.h available */
 #else
 #include <sys/wait.h>
 #endif
@@ -350,7 +350,7 @@ __gnat_expect_poll (int *fd,
 
   return ready;
 }
-#elif defined (__unix__) && !defined (__nucleus__)
+#elif defined (__unix__)
 
 #ifdef __hpux__
 #include <sys/ptyio.h>

gcc/ada/gsocket.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *         Copyright (C) 2004-2014, Free Software Foundation, Inc.          *
+ *         Copyright (C) 2004-2015, Free Software Foundation, Inc.          *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -29,7 +29,7 @@
  *                                                                          *
  ****************************************************************************/
 
-#if defined(__nucleus__) || defined(VTHREADS) || defined(__PikeOS__)
+#if defined(VTHREADS) || defined(__PikeOS__)
 
 /* Sockets not supported on these platforms.  */
 #undef HAVE_SOCKETS
@@ -251,4 +251,4 @@
 # define HAVE_INET_PTON
 #endif
 
-#endif /* defined(__nucleus__) */
+#endif /* defined(VTHREADS) */

gcc/ada/impunit.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2000-2014, Free Software Foundation, Inc.        --
+--           Copyright (C) 2000-2015, Free Software Foundation, Inc.        --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -427,6 +427,7 @@ package body Impunit is
     ("a-coorse", T),  -- Ada.Containers.Ordered_Sets
     ("a-coteio", T),  -- Ada.Complex_Text_IO
     ("a-direct", T),  -- Ada.Directories
+    ("a-dinopr", T),  -- Ada.Dispatching.Non_Preemptive
     ("a-diroro", T),  -- Ada.Dispatching.Round_Robin
     ("a-disedf", T),  -- Ada.Dispatching.EDF
     ("a-dispat", T),  -- Ada.Dispatching

gcc/ada/par-ch3.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1455,6 +1455,16 @@ package body Ch3 is
 
          else
             Restore_Scan_State (Scan_State);
+
+            --  Reset Token_Node, because it already got changed from an
+            --  Identifier to a Defining_Identifier, and we don't want that
+            --  for a statement!
+
+            Token_Node :=
+              Make_Identifier (Sloc (Token_Node), Chars (Token_Node));
+
+            --  And now scan out one or more statements
+
             Statement_When_Declaration_Expected (Decls, Done, In_Spec);
             return;
          end if;
@@ -4777,6 +4787,12 @@ package body Ch3 is
          if In_Spec then
             null;
 
+         --  Just ignore it if we are in -gnatd.2 (allow statements to appear
+         --  in declaration sequences) mode.
+
+         elsif Debug_Flag_Dot_2 then
+            null;
+
          --  In the declarative part case, take a second statement as a sure
          --  sign that we really have a missing BEGIN, and end the declarative
          --  part now. Note that the caller will fix up the first message to
@@ -4790,6 +4806,11 @@ package body Ch3 is
       --  Case of first occurrence of unexpected statement
 
       else
+         --  Do not give error message if we are operating in -gnatd.2 mode
+         --  (alllow statements to appear in declarative parts).
+
+         if not Debug_Flag_Dot_2 then
+
             --  If we are in a package spec, then give message of statement
             --  not allowed in package spec. This message never gets changed.
 
@@ -4811,6 +4832,7 @@ package body Ch3 is
 
             Missing_Begin_Msg := Get_Msg_Id;
          end if;
+      end if;
 
       --  In all cases except the case in which we decided to terminate the
       --  declaration sequence on a second error, we scan out the statement

gcc/ada/s-oscons-tmplt.c

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -108,16 +108,7 @@ pragma Style_Checks ("M32766");
 #include <fcntl.h>
 #include <time.h>
 
-#if defined (__VMS)
-/** VMS is unable to do vector IO operations with default value of IOV_MAX,
- ** so its value is redefined to a small one which is known to work properly.
- **/
-#undef IOV_MAX
-#define IOV_MAX 16
-#endif
-
-#if ! (defined (__vxworks) || defined (__VMS) || defined (__MINGW32__) || \
-       defined (__nucleus__))
+#if ! (defined (__vxworks) || defined (__MINGW32__))
 # define HAVE_TERMIOS
 #endif
 
@@ -286,12 +277,10 @@ package System.OS_Constants is
    -- General platform parameters --
    ---------------------------------
 
-   type OS_Type is (Windows, VMS, Other_OS);
+   type OS_Type is (Windows, Other_OS);
 */
 #if defined (__MINGW32__)
 # define TARGET_OS "Windows"
-#elif defined (__VMS)
-# define TARGET_OS "VMS"
 #else
 # define TARGET_OS "Other_OS"
 #endif

gcc/ada/sem_prag.adb

@@ -5918,6 +5918,17 @@ package body Sem_Prag is
             --  Get name from corresponding aspect
 
             Error_Msg_Name_1 := Original_Aspect_Name (N);
+
+            if Class_Present (N) then
+
+               --  Replace the name with a leading underscore used
+               --  internally, with a name that is more user-friendly.
+
+               if Error_Msg_Name_1 = Name_uType_Invariant then
+                  Error_Msg_Name_1 := Name_Type_Invariant_Class;
+               end if;
+            end if;
+
          end if;
 
          --  Return possibly modified message

gcc/ada/sem_res.adb

@@ -10715,14 +10715,22 @@ package body Sem_Res is
 
          begin
             --  If the type of the operand is a limited view, use the non-
-            --  limited view when available.
+            --  limited view when available. If it is a class-wide type,
+            --  recover class_wide type of the non-limited view.
 
-            if From_Limited_With (Opnd)
-              and then Ekind (Opnd) in Incomplete_Kind
+            if From_Limited_With (Opnd) then
+               if Ekind (Opnd) in Incomplete_Kind
                  and then Present (Non_Limited_View (Opnd))
                then
                   Opnd := Non_Limited_View (Opnd);
                   Set_Etype (Expression (N), Opnd);
+
+               elsif Is_Class_Wide_Type (Opnd)
+                 and then Present (Non_Limited_View (Etype (Opnd)))
+               then
+                  Opnd := Class_Wide_Type (Non_Limited_View (Etype (Opnd)));
+                  Set_Etype (Expression (N), Opnd);
+               end if;
             end if;
 
             if Is_Access_Type (Opnd) then

gcc/ada/snames.ads-tmpl

@@ -1066,7 +1066,7 @@ package Snames is
    First_Task_Dispatching_Policy_Name         : constant Name_Id := N + $;
    Name_EDF_Across_Priorities                 : constant Name_Id := N + $;
    Name_FIFO_Within_Priorities                : constant Name_Id := N + $;
-   Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + $;
+   Name_Non_Preemptive_FIFO_Within_Priorities : constant Name_Id := N + $;
    Name_Round_Robin_Within_Priorities         : constant Name_Id := N + $;
    Last_Task_Dispatching_Policy_Name          : constant Name_Id := N + $;
 

gcc/ada/sysdep.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *         Copyright (C) 1992-2014, Free Software Foundation, Inc.          *
+ *         Copyright (C) 1992-2015, Free Software Foundation, Inc.          *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -58,9 +58,6 @@
 #include "tsystem.h"
 #include <fcntl.h>
 #include <sys/stat.h>
-#ifdef VMS
-#include <unixio.h>
-#endif
 #else
 #include "config.h"
 #include "system.h"
@@ -190,8 +187,6 @@ __gnat_ttyname (int filedes)
 #if defined (__CYGWIN__) || defined (__MINGW32__)
 #include <windows.h>
 
-#ifndef RTX
-
 int __gnat_is_windows_xp (void);
 
 int
@@ -216,8 +211,6 @@ __gnat_is_windows_xp (void)
   return is_win_xp;
 }
 
-#endif /* !RTX */
-
 /* Get the bounds of the stack.  The stack pointer is supposed to be
    initialized to BASE when a thread is created and the stack can be extended
    to LIMIT before reaching a guard page.
@@ -279,13 +272,13 @@ __gnat_set_mode (int handle ATTRIBUTE_UNUSED, int mode ATTRIBUTE_UNUSED)
 char *
 __gnat_ttyname (int filedes)
 {
-#if defined (__vxworks) || defined (__nucleus)
+#if defined (__vxworks)
   return "";
 #else
   extern char *ttyname (int);
 
   return ttyname (filedes);
-#endif /* defined (__vxworks) || defined (__nucleus) */
+#endif /* defined (__vxworks) */
 }
 #endif
 
@@ -306,11 +299,6 @@ __gnat_ttyname (int filedes)
 #  include <termios.h>
 # endif
 
-#else
-# if defined (VMS)
-extern char *decc$ga_stdscr;
-static int initted = 0;
-# endif
 #endif
 
 /* Implements the common processing for getc_immediate and
@@ -424,29 +412,6 @@ getc_immediate_common (FILE *stream,
     }
 
   else
-#elif defined (VMS)
-  int fd = fileno (stream);
-
-  if (isatty (fd))
-    {
-      if (initted == 0)
-	{
-	  decc$bsd_initscr ();
-	  initted = 1;
-	}
-
-      decc$bsd_cbreak ();
-      *ch = decc$bsd_wgetch (decc$ga_stdscr);
-
-      if (*ch == 4)
-	*end_of_file = 1;
-      else
-	*end_of_file = 0;
-
-      *avail = 1;
-      decc$bsd_nocbreak ();
-    }
-  else
 #elif defined (__MINGW32__)
   int fd = fileno (stream);
   int char_waiting;
@@ -629,23 +594,6 @@ rts_get_nShowCmd (void)
 }
 
 #endif /* WINNT */
-#ifdef VMS
-
-/* This gets around a problem with using the old threads library on VMS 7.0. */
-
-extern long get_gmtoff (void);
-
-long
-get_gmtoff (void)
-{
-  time_t t;
-  struct tm *ts;
-
-  t = time ((time_t) 0);
-  ts = localtime (&t);
-  return ts->tm_gmtoff;
-}
-#endif
 
 /* This value is returned as the time zone offset when a valid value
    cannot be determined. It is simply a bizarre value that will never
@@ -689,25 +637,18 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
 {
   TIME_ZONE_INFORMATION tzi;
 
-  BOOL  rtx_active;
   DWORD tzi_status;
 
-#ifdef RTX
-  rtx_active = 1;
-#else
-  rtx_active = 0;
-#endif
-
   (*Lock_Task) ();
 
   tzi_status = GetTimeZoneInformation (&tzi);
 
-  /* Processing for RTX targets or cases where we simply want to extract the
-     offset of the current time zone, regardless of the date. A value of "0"
-     for flag "is_historic" signifies that the date is NOT historic, see the
+  /* Cases where we simply want to extract the offset of the current time
+     zone, regardless of the date. A value of "0" for flag "is_historic"
+     signifies that the date is NOT historic, see the
      body of Ada.Calendar.UTC_Time_Offset. */
 
-  if (rtx_active || *is_historic == 0) {
+  if (*is_historic == 0) {
     *off = tzi.Bias;
 
     /* The system is operating in the range covered by the StandardDate
@@ -775,12 +716,10 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
   (*Unlock_Task) ();
 }
 
-#else
+#elif defined (__Lynx__)
 
 /* On Lynx, all time values are treated in GMT */
 
-#if defined (__Lynx__)
-
 /* As of LynxOS 3.1.0a patch level 040, LynuxWorks changes the
    prototype to the C library function localtime_r from the POSIX.4
    Draft 9 to the POSIX 1.c version. Before this change the following
@@ -798,13 +737,7 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
 
 #else
 
-/* VMS does not need __gnat_localtime_tzoff */
-
-#if defined (VMS)
-
-/* Other targets except Lynx, VMS and Windows provide a standard localtime_r */
-
-#else
+/* Other targets except Lynx and Windows provide a standard localtime_r */
 
 #define Lock_Task system__soft_links__lock_task
 extern void (*Lock_Task) (void);
@@ -898,12 +831,10 @@ __gnat_localtime_tzoff (const time_t *timer ATTRIBUTE_UNUSED,
 #else
   *off = 0;
 
-#endif
+#endif  /* defined(_AIX) ... */
 }
 
 #endif
-#endif
-#endif
 
 #ifdef __vxworks