Commit 2b9fbec9 by Arnaud Charlet

[multiple changes]

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_case.adb (Dup_Choice): Improve message for integer constants.

2014-08-01  Arnaud Charlet  <charlet@adacore.com>

	* gnatlink.adb: Remove special handling of VMS, RTX and JVM.

2014-08-01  Pascal Obry  <obry@adacore.com>

	* adaint.h (GNAT_OPEN): Defines as open64 where supported.
	* adaint.c (GNAT_OPEN): Uses new macro where needed.

From-SVN: r213410
parent 0494285a
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_case.adb (Dup_Choice): Improve message for integer constants.
2014-08-01 Arnaud Charlet <charlet@adacore.com>
* gnatlink.adb: Remove special handling of VMS, RTX and JVM.
2014-08-01 Pascal Obry <obry@adacore.com>
* adaint.h (GNAT_OPEN): Defines as open64 where supported.
* adaint.c (GNAT_OPEN): Uses new macro where needed.
2014-07-31 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (lookup_and_insert_pad_type): New function
......
......@@ -1007,7 +1007,7 @@ __gnat_open_read (char *path, int fmode)
fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
}
#else
fd = open (path, O_RDONLY | o_fmode);
fd = GNAT_OPEN (path, O_RDONLY | o_fmode);
#endif
return fd < 0 ? -1 : fd;
......@@ -1048,7 +1048,7 @@ __gnat_open_rw (char *path, int fmode)
fd = _topen (wpath, O_RDWR | o_fmode, PERM);
}
#else
fd = open (path, O_RDWR | o_fmode, PERM);
fd = GNAT_OPEN (path, O_RDWR | o_fmode, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1074,7 +1074,7 @@ __gnat_open_create (char *path, int fmode)
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1096,7 +1096,7 @@ __gnat_create_output_file (char *path)
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1118,7 +1118,7 @@ __gnat_create_output_file_new (char *path)
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1144,7 +1144,7 @@ __gnat_open_append (char *path, int fmode)
fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1172,7 +1172,7 @@ __gnat_open_new (char *path, int fmode)
fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
#endif
return fd < 0 ? -1 : fd;
......@@ -1213,7 +1213,7 @@ __gnat_open_new_temp (char *path, int fmode)
fmode ? "rfm=stmlf" : "rfm=udf", "ctx=rec", "rat=none",
"shr=del,get,put,upd", "mbc=16", "deq=64", "fop=tef");
#else
fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
#endif
return fd < 0 ? -1 : fd;
......
......@@ -53,12 +53,14 @@ extern "C" {
#if defined (__GLIBC__) || defined (sun)
#define GNAT_FOPEN fopen64
#define GNAT_OPEN open64
#define GNAT_STAT stat64
#define GNAT_FSTAT fstat64
#define GNAT_LSTAT lstat64
#define GNAT_STRUCT_STAT struct stat64
#else
#define GNAT_FOPEN fopen
#define GNAT_OPEN open
#define GNAT_STAT stat
#define GNAT_FSTAT fstat
#define GNAT_LSTAT lstat
......
......@@ -456,12 +456,33 @@ package body Sem_Case is
return;
end if;
-- Case of only one value that is missing
-- Case of only one value that is duplicated
if Lo = Hi then
-- Integer type
if Is_Integer_Type (Bounds_Type) then
Error_Msg_Uint_1 := Lo;
Error_Msg_N ("duplication of choice value: ^#!", C);
-- We have an integer value, Lo, but if the given choice
-- placement is a constant with that value, then use the
-- name of that constant instead in the message:
if Nkind (C) = N_Identifier
and then Compile_Time_Known_Value (C)
and then Expr_Value (C) = Lo
then
Error_Msg_N ("duplication of choice value: &#!", C);
-- Not that special case, so just output the integer value
else
Error_Msg_Uint_1 := Lo;
Error_Msg_N ("duplication of choice value: ^#!", C);
end if;
-- Enumeration type
else
Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
Error_Msg_N ("duplication of choice value: %#!", C);
......@@ -470,10 +491,38 @@ package body Sem_Case is
-- More than one choice value, so print range of values
else
-- Integer type
if Is_Integer_Type (Bounds_Type) then
Error_Msg_Uint_1 := Lo;
Error_Msg_Uint_2 := Hi;
Error_Msg_N ("duplication of choice values: ^ .. ^#!", C);
-- Similar to the above, if C is a range of known values which
-- match Lo and Hi, then use the names. We have to go to the
-- original nodes, since the values will have been rewritten
-- to their integer values.
if Nkind (C) = N_Range
and then Nkind (Original_Node (Low_Bound (C))) = N_Identifier
and then Nkind (Original_Node (High_Bound (C))) = N_Identifier
and then Compile_Time_Known_Value (Low_Bound (C))
and then Compile_Time_Known_Value (High_Bound (C))
and then Expr_Value (Low_Bound (C)) = Lo
and then Expr_Value (High_Bound (C)) = Hi
then
Error_Msg_Node_2 := Original_Node (High_Bound (C));
Error_Msg_N
("duplication of choice values: & .. &#!",
Original_Node (Low_Bound (C)));
-- Not that special case, output integer values
else
Error_Msg_Uint_1 := Lo;
Error_Msg_Uint_2 := Hi;
Error_Msg_N ("duplication of choice values: ^ .. ^#!", C);
end if;
-- Enumeration type
else
Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
Error_Msg_Name_2 := Choice_Image (Hi, Bounds_Type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment