+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.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
------------------------------------------------------------------------------
package Ada.Dispatching is
- pragma Pure (Dispatching);
+ pragma Preelaborate (Dispatching);
+
+ procedure Yield;
Dispatching_Policy_Error : exception;
end Ada.Dispatching;
#if defined (__MINGW32__) || defined (__CYGWIN__)
-#if defined (RTX)
-#include <windows.h>
-#include <Rtapi.h>
-#else
#include "mingw32.h"
/* Current code page and CCS encoding to use, set in initialize.c. */
UINT CurrentCodePage;
UINT CurrentCCSEncoding;
-#endif
#include <sys/utime.h>
preventing the inclusion of the GCC header from doing anything. */
# define GCC_RESOURCE_H
# include <sys/wait.h>
-#elif defined (__nucleus__) || defined (__PikeOS__)
+#elif defined (__PikeOS__)
/* No wait() or waitpid() calls available. */
#else
/* Default case. */
const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
-#if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
+#if defined (__vxworks)
#define GNAT_MAX_PATH_LEN PATH_MAX
#else
size_t bufsiz ATTRIBUTE_UNUSED)
{
#if defined (_WIN32) \
- || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
+ || defined(__vxworks) || defined (__PikeOS__)
return -1;
#else
return readlink (path, buf, bufsiz);
char *newpath ATTRIBUTE_UNUSED)
{
#if defined (_WIN32) \
- || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
+ || defined(__vxworks) || defined (__PikeOS__)
return -1;
#else
return symlink (oldpath, newpath);
/* Try to lock a file, return 1 if success. */
-#if defined (__vxworks) || defined (__nucleus__) \
+#if defined (__vxworks) \
|| defined (_WIN32) || defined (__PikeOS__)
/* Version that does not use link. */
return mkstemp (path);
#elif defined (__Lynx__)
mktemp (path);
-#elif defined (__nucleus__)
- return -1;
#else
if (mktemp (path) == NULL)
return -1;
attr->exists = !ret;
-#if !defined (_WIN32) || defined (RTX)
+#if !defined (_WIN32)
/* on Windows requires extra system call, see __gnat_is_readable_file_attr */
attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
void
__gnat_tmp_name (char *tmp_filename)
{
-#ifdef RTX
- /* Variable used to create a series of unique names */
- static int counter = 0;
-
- /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
- strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
- sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
{
char *pname;
char prefix[25];
DIR* __gnat_opendir (char *name)
{
-#if defined (RTX)
- /* Not supported in RTX */
-
- return NULL;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
char *
__gnat_readdir (DIR *dirp, char *buffer, int *len)
{
-#if defined (RTX)
- /* Not supported in RTX */
-
- return NULL;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
if (dirent != NULL)
int __gnat_closedir (DIR *dirp)
{
-#if defined (RTX)
- /* Not supported in RTX */
-
- return 0;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
return _tclosedir ((_TDIR*)dirp);
#else
#endif
}
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
/* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
static const unsigned long long w32_epoch_offset = 11644473600ULL;
__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
{
if (attr->timestamp == (OS_Time)-2) {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
BOOL res;
WIN32_FILE_ATTRIBUTE_DATA fad;
__time64_t ret = -1;
__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
{
if (attr->timestamp == (OS_Time)-2) {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h);
attr->timestamp = (OS_Time) ret;
/* Code to implement __gnat_set_file_time_name for these systems. */
-#elif defined (_WIN32) && !defined (RTX)
+#elif defined (_WIN32)
union
{
FILETIME ft_time;
result[0] = '\0';
-#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
- && ! defined (RTX)
+#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
HKEY reg_key;
DWORD name_size, value_size;
return __gnat_is_directory_attr (name, &attr);
}
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
/* Returns the same constant as GetDriveType but takes a pathname as
argument. */
return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
}
-#endif /* defined (_WIN32) && !defined (RTX) */
+#endif /* defined (_WIN32) */
int
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
{
if (attr->readable == ATTR_UNSET)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
{
if (attr->writable == ATTR_UNSET)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
{
if (attr->executable == ATTR_UNSET)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
void
__gnat_set_writable (char *name)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
SetFileAttributes
(wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
- ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0)
void
__gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
- ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0)
void
__gnat_set_non_writable (char *name)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
SetFileAttributes
(wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
- ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0)
void
__gnat_set_readable (char *name)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
- ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0)
void
__gnat_set_non_readable (char *name)
{
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
- ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0)
{
if (attr->symbolic_link == ATTR_UNSET)
{
-#if defined (__vxworks) || defined (__nucleus__)
+#if defined (__vxworks)
attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int finished ATTRIBUTE_UNUSED;
int pid ATTRIBUTE_UNUSED;
-#if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
- || defined(__PikeOS__)
+#if defined (__vxworks) || defined(__PikeOS__)
return -1;
#elif defined (_WIN32)
/* WIN32 code to implement a wait call that wait for any child process. */
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
/* Synchronization code, to be thread safe. */
__gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
{
-#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
- || defined (__PikeOS__)
+#if defined (__vxworks) || defined (__PikeOS__)
/* Not supported. */
return -1;
int status = 0;
int pid = 0;
-#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
- || defined (__PikeOS__)
+#if defined (__vxworks) || defined (__PikeOS__)
/* Not sure what to do here, so do nothing but return zero. */
#elif defined (_WIN32)
{
char *apath_val;
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
TCHAR *wpath_val = _tgetenv (_T("PATH"));
TCHAR *wapath_val;
/* In Win32 systems we expand the PATH as for XP environment
__gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
int mode ATTRIBUTE_UNUSED)
{
-#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
- defined (__nucleus__)
+#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
return -1;
-#elif defined (_WIN32) && !defined (RTX)
+#elif defined (_WIN32)
TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
TCHAR wto [GNAT_MAX_PATH_LEN + 2];
BOOL res;
#endif
}
-#ifdef RTX
-
-/* In RTX mode, the procedure to get the time (as file time) is different
- in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
- we introduce an intermediate procedure to link against the corresponding
- one in each situation. */
-
-extern void GetTimeAsFileTime (LPFILETIME pTime);
-
-void GetTimeAsFileTime (LPFILETIME pTime)
-{
-#ifdef RTSS
- RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
-#else
- GetSystemTimeAsFileTime (pTime); /* w32 interface */
-#endif
-}
-
-#ifdef RTSS
-/* Add symbol that is required to link. It would otherwise be taken from
- libgcc.a and it would try to use the gcc constructors that are not
- supported by Microsoft linker. */
-
-extern void __main (void);
-
-void __main (void)
-{
-}
-#endif /* RTSS */
-#endif /* RTX */
-
#if defined (__ANDROID__)
#include <pthread.h>
-- --
-- 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- --
-- 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
-- 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 --
------------------------------------------
* *
* 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- *
/* ??? 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
return ready;
}
-#elif defined (__unix__) && !defined (__nucleus__)
+#elif defined (__unix__)
#ifdef __hpux__
#include <sys/ptyio.h>
* *
* 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- *
* *
****************************************************************************/
-#if defined(__nucleus__) || defined(VTHREADS) || defined(__PikeOS__)
+#if defined(VTHREADS) || defined(__PikeOS__)
/* Sockets not supported on these platforms. */
#undef HAVE_SOCKETS
# define HAVE_INET_PTON
#endif
-#endif /* defined(__nucleus__) */
+#endif /* defined(VTHREADS) */
-- --
-- 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- --
("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
-- --
-- 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- --
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;
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
-- Case of first occurrence of unexpected statement
else
- -- If we are in a package spec, then give message of statement
- -- not allowed in package spec. This message never gets changed.
+ -- Do not give error message if we are operating in -gnatd.2 mode
+ -- (alllow statements to appear in declarative parts).
- if In_Spec then
- Error_Msg_SC ("statement not allowed in package spec");
+ if not Debug_Flag_Dot_2 then
- -- If in declarative part, then we give the message complaining
- -- about finding a statement when a declaration is expected. This
- -- gets changed to a complaint about a missing BEGIN if we later
- -- find that no BEGIN is present.
+ -- If we are in a package spec, then give message of statement
+ -- not allowed in package spec. This message never gets changed.
- else
- Error_Msg_SC ("statement not allowed in declarative part");
- end if;
+ if In_Spec then
+ Error_Msg_SC ("statement not allowed in package spec");
- -- Capture message Id. This is used for two purposes, first to
- -- stop multiple messages, see test above, and second, to allow
- -- the replacement of the message in the declarative part case.
+ -- If in declarative part, then we give the message complaining
+ -- about finding a statement when a declaration is expected. This
+ -- gets changed to a complaint about a missing BEGIN if we later
+ -- find that no BEGIN is present.
- Missing_Begin_Msg := Get_Msg_Id;
+ else
+ Error_Msg_SC ("statement not allowed in declarative part");
+ end if;
+
+ -- Capture message Id. This is used for two purposes, first to
+ -- stop multiple messages, see test above, and second, to allow
+ -- the replacement of the message in the declarative part case.
+
+ Missing_Begin_Msg := Get_Msg_Id;
+ end if;
end if;
-- In all cases except the case in which we decided to terminate the
-- --
-- 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- --
#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
-- 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
-- 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
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
- and then Present (Non_Limited_View (Opnd))
- then
- Opnd := Non_Limited_View (Opnd);
- Set_Etype (Expression (N), Opnd);
+ 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
-- for FIFO_Within_Priorities). If new policy names are added, the first
-- character must be distinct.
- 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_Round_Robin_Within_Priorities : constant Name_Id := N + $;
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + $;
+ 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_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 + $;
-- Names of recognized partition elaboration policy identifiers
* *
* 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- *
#include "tsystem.h"
#include <fcntl.h>
#include <sys/stat.h>
-#ifdef VMS
-#include <unixio.h>
-#endif
#else
#include "config.h"
#include "system.h"
#if defined (__CYGWIN__) || defined (__MINGW32__)
#include <windows.h>
-#ifndef RTX
-
int __gnat_is_windows_xp (void);
int
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.
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
\f
# 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
}
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;
}
#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
{
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
(*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
#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);
#else
*off = 0;
-#endif
+#endif /* defined(_AIX) ... */
}
-#endif
-#endif
#endif
#ifdef __vxworks
projects / gcc.git / commitdiff