procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2011-11-21  Tristan Gingold  <gingold@adacore.com>

	* env.c: Remove unused declaration.

2011-11-21  Pascal Obry  <obry@adacore.com>

	* s-os_lib.ads: Minor style fix.

2011-11-21  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_dup2): When fd are stdout, stdin or stderr and
	identical, do nothing on Windows XP.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Constrain_Index, Process_Range_Expr_In_Decl):
	Use Full_Expander_Active instead of Expander_Active to control
	the forced evaluation of expressions for the sake of generating
	checks.

2011-11-21  Thomas Quinot  <quinot@adacore.com>

	* init.c: On FreeBSD, stack checking failures may raise SIGBUS.

2011-11-21  Tristan Gingold  <gingold@adacore.com>

	* sysdep.c (mode_read_text, mode_write_text, mode_append_text,
	mode_read_binary, mode_write_binary, mode_append_binary,
	mode_read_text_plus, mode_write_text_plus, mode_append_text_plus,
	mode_read_binary_plus, mode_write_binary_plus,
	mode_append_binary_plus): Remove unused declarations.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Minor rewording.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_imgv.adb (Expand_Width_Attribute): Emit
	an error message rather than a warning when pragma Discard_Names
	prevents the computation of 'Width. Do not emit an error through
	the use of RE_Null.

2011-11-21  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add
	implicit type conversion when the type of the allocator is an
	interface. Done to force generation of displacement of the "this"
	pointer when required.

2011-11-21  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: Corresponding_Spec applies to expression
	functions, and is set when the expression is a completion of a
	previous declaration.
	* sem_ch6.adb (Analyze_Expression_Function): To determine properly
	whether an expression function completes a previous declaration,
	use Find_Corresponding_Spec, as when analyzing a subprogram body.

2011-11-21  Steve Baird  <baird@adacore.com>

	* sem_util.adb (Deepest_Type_Access_Level): Improve comment.
	(Type_Access_Level): Improve comment.

From-SVN: r181575
This commit is contained in:
Arnaud Charlet 2011-11-21 14:23:52 +01:00
parent 08ef33f5eb
commit d2d4b3556d
14 changed files with 157 additions and 116 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
gcc/ada/ChangeLog
View file

@ -1,3 +1,67 @@
2011-11-21 Tristan Gingold <gingold@adacore.com>
* env.c: Remove unused declaration.
2011-11-21 Pascal Obry <obry@adacore.com>
* s-os_lib.ads: Minor style fix.
2011-11-21 Pascal Obry <obry@adacore.com>
* adaint.c (__gnat_dup2): When fd are stdout, stdin or stderr and
identical, do nothing on Windows XP.
2011-11-21 Yannick Moy <moy@adacore.com>
* sem_ch3.adb (Constrain_Index, Process_Range_Expr_In_Decl):
Use Full_Expander_Active instead of Expander_Active to control
the forced evaluation of expressions for the sake of generating
checks.
2011-11-21 Thomas Quinot <quinot@adacore.com>
* init.c: On FreeBSD, stack checking failures may raise SIGBUS.
2011-11-21 Tristan Gingold <gingold@adacore.com>
* sysdep.c (mode_read_text, mode_write_text, mode_append_text,
mode_read_binary, mode_write_binary, mode_append_binary,
mode_read_text_plus, mode_write_text_plus, mode_append_text_plus,
mode_read_binary_plus, mode_write_binary_plus,
mode_append_binary_plus): Remove unused declarations.
2011-11-21 Yannick Moy <moy@adacore.com>
* gnat_rm.texi: Minor rewording.
2011-11-21 Hristian Kirtchev <kirtchev@adacore.com>
* exp_imgv.adb (Expand_Width_Attribute): Emit
an error message rather than a warning when pragma Discard_Names
prevents the computation of 'Width. Do not emit an error through
the use of RE_Null.
2011-11-21 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add
implicit type conversion when the type of the allocator is an
interface. Done to force generation of displacement of the "this"
pointer when required.
2011-11-21 Ed Schonberg <schonberg@adacore.com>
* sinfo.ads, sinfo.adb: Corresponding_Spec applies to expression
functions, and is set when the expression is a completion of a
previous declaration.
* sem_ch6.adb (Analyze_Expression_Function): To determine properly
whether an expression function completes a previous declaration,
use Find_Corresponding_Spec, as when analyzing a subprogram body.
2011-11-21 Steve Baird <baird@adacore.com>
* sem_util.adb (Deepest_Type_Access_Level): Improve comment.
(Type_Access_Level): Improve comment.
2011-11-21 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/Makefile.in (INCLUDES_FOR_SUBDIR): Add $(fsrcdir) by

8
gcc/ada/adaint.c
View file

@ -2449,6 +2449,14 @@ __gnat_dup2 (int oldfd, int newfd)
/* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
RTPs. */
return -1;
#elif defined (_WIN32)
/* Special case when oldfd and newfd are identical and are the standard
input, output or error as this makes Windows XP hangs. Note that we
do that only for standard file descriptors that are known to be valid. */
if (oldfd == newfd && newfd >= 0 && newfd <= 2)
return newfd;
else
return dup2 (oldfd, newfd);
#else
return dup2 (oldfd, newfd);
#endif

2
gcc/ada/env.c
View file

@ -110,8 +110,6 @@ __gnat_getenv (char *name, int *len, char **value)
#ifdef VMS
static char *to_host_path_spec (char *);
typedef struct _ile3
{
unsigned short len, code;

9
gcc/ada/exp_ch6.adb
View file

@ -7805,6 +7805,15 @@ package body Exp_Ch6 is
-- to the object created by the allocator).
Rewrite (Allocator, Make_Reference (Loc, Relocate_Node (Function_Call)));
-- Ada 2005 (AI-251): If the type of the allocator is an interface then
-- generate an implicit conversion to force displacement of the "this"
-- pointer.
if Is_Interface (Designated_Type (Acc_Type)) then
Rewrite (Allocator, Convert_To (Acc_Type, Relocate_Node (Allocator)));
end if;
Analyze_And_Resolve (Allocator, Acc_Type);
end Make_Build_In_Place_Call_In_Allocator;

36
gcc/ada/exp_imgv.adb
View file

@ -1156,31 +1156,27 @@ package body Exp_Imgv is
else
pragma Assert (Is_Enumeration_Type (Rtyp));
-- Whenever pragma Discard_Names is in effect, it suppresses the
-- generation of string literals for enumeration types. Since the
-- literals are required to evaluate the 'Width of an enumeration
-- type, emit an error.
-- ??? This is fine for configurable runtimes, but dubious in the
-- general case. For now keep both error messages until this issue
-- has been verified with the ARG.
if Discard_Names (Rtyp) then
Error_Msg_Name_1 := Attribute_Name (N);
-- Emit a detailed warning in configurable run-time mode because
-- loading RE_Null does not give a precise indication of the real
-- issue.
if Configurable_Run_Time_Mode
and then not Has_Warnings_Off (Rtyp)
then
Error_Msg_Name_1 := Attribute_Name (N);
Error_Msg_N ("?attribute % not supported in configurable " &
if Configurable_Run_Time_Mode then
Error_Msg_N ("attribute % not supported in configurable " &
"run-time mode", N);
else
Error_Msg_N ("attribute % not supported when pragma " &
"Discard_Names is in effect", N);
end if;
-- This is a configurable run-time, or else a restriction is in
-- effect. In either case the attribute cannot be supported. Force
-- a load error from Rtsfind to generate an appropriate message,
-- as is done with other ZFP violations.
declare
Discard : constant Entity_Id := RTE (RE_Null);
pragma Unreferenced (Discard);
begin
return;
end;
return;
end if;
Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));

11
gcc/ada/gnat_rm.texi
View file

@ -6372,12 +6372,11 @@ refer to the value of the prefix on entry. So for
example if you have an argument of a record type X called Arg1,
you can refer to Arg1.Field'Old which yields the value of
Arg1.Field on entry. The implementation simply involves generating
an object declaration which captures the value on entry. Any
prefix is allowed except one of a limited type (since limited
types cannot be copied to capture their values) or an expression
which references a local variable
(since local variables do not exist at subprogram entry time).
an object declaration which captures the value on entry.
The prefix must denote an object of a nonlimited type (since limited types
cannot be copied to capture their values) and it must not reference a local
variable (since local variables do not exist at subprogram entry time). Note
that the variable introduced by a quantified expression is a local variable.
The following example shows the use of 'Old to implement
a test of a postcondition:

4
gcc/ada/init.c
View file

@ -1808,8 +1808,8 @@ __gnat_error_handler (int sig,
break;
case SIGBUS:
exception = &constraint_error;
msg = "SIGBUS";
exception = &storage_error;
msg = "SIGBUS: possible stack overflow";
break;
default:

2
gcc/ada/s-os_lib.ads
View file

@ -174,7 +174,7 @@ package System.OS_Lib is
-- File descriptors for standard input output files
Invalid_FD : constant File_Descriptor := -1;
-- File descriptor returned when error in opening/creating file;
-- File descriptor returned when error in opening/creating file
type Mode is (Binary, Text);
for Mode'Size use Integer'Size;

6
gcc/ada/sem_ch3.adb
View file

@ -11786,7 +11786,7 @@ package body Sem_Ch3 is
-- needed, since checks may cause duplication of the expressions
-- which must not be reevaluated.
if Expander_Active then
if Full_Expander_Active then
Force_Evaluation (Low_Bound (R));
Force_Evaluation (High_Bound (R));
end if;
@ -18326,7 +18326,7 @@ package body Sem_Ch3 is
-- if needed, before applying checks, since checks may cause
-- duplication of the expression without forcing evaluation.
if Expander_Active then
if Full_Expander_Active then
Force_Evaluation (Lo);
Force_Evaluation (Hi);
end if;
@ -18436,7 +18436,7 @@ package body Sem_Ch3 is
-- Case of other than an explicit N_Range node
elsif Expander_Active then
elsif Full_Expander_Active then
Get_Index_Bounds (R, Lo, Hi);
Force_Evaluation (Lo);
Force_Evaluation (Hi);

35
gcc/ada/sem_ch6.adb
View file

@ -268,16 +268,22 @@ package body Sem_Ch6 is
procedure Analyze_Expression_Function (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
LocX : constant Source_Ptr := Sloc (Expression (N));
Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
Expr : constant Node_Id := Expression (N);
Spec : constant Node_Id := Specification (N);
Def_Id : Entity_Id;
pragma Unreferenced (Def_Id);
Prev : Entity_Id;
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed. Def_Id is needed to analyze the spec.
New_Body : Node_Id;
New_Decl : Node_Id;
Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed.
New_Spec : Node_Id;
begin
-- This is one of the occasions on which we transform the tree during
-- semantic analysis. If this is a completion, transform the expression
-- function into an equivalent subprogram body, and analyze it.
@ -286,10 +292,22 @@ package body Sem_Ch6 is
-- determine whether this is possible.
Inline_Processing_Required := True;
New_Spec := Copy_Separate_Tree (Spec);
Prev := Current_Entity_In_Scope (Defining_Entity (Spec));
-- If there are previous overloadable entities with the same name,
-- check whether any of them is completed by the expression function.
if Present (Prev)
and then Is_Overloadable (Prev)
then
Def_Id := Analyze_Subprogram_Specification (Spec);
Prev := Find_Corresponding_Spec (N);
end if;
New_Body :=
Make_Subprogram_Body (Loc,
Specification => Copy_Separate_Tree (Specification (N)),
Specification => New_Spec,
Declarations => Empty_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (LocX,
@ -307,6 +325,7 @@ package body Sem_Ch6 is
Insert_After (N, New_Body);
Rewrite (N, Make_Null_Statement (Loc));
Set_Has_Completion (Prev, False);
Analyze (N);
Analyze (New_Body);
Set_Is_Inlined (Prev);
@ -314,6 +333,7 @@ package body Sem_Ch6 is
elsif Present (Prev)
and then Comes_From_Source (Prev)
then
Set_Has_Completion (Prev, False);
Rewrite (N, New_Body);
Analyze (N);
@ -333,8 +353,7 @@ package body Sem_Ch6 is
else
New_Decl :=
Make_Subprogram_Declaration (Loc,
Specification => Specification (N));
Make_Subprogram_Declaration (Loc, Specification => Spec);
Rewrite (N, New_Decl);
Analyze (N);

18
gcc/ada/sem_util.adb
View file

@ -2437,7 +2437,8 @@ package body Sem_Util is
(Defining_Identifier
(Associated_Node_For_Itype (Typ))));
-- For generic formal type, return Int'Last (infinite) (why ???)
-- For generic formal type, return Int'Last (infinite).
-- See comment preceding Is_Generic_Type call in Type_Access_Level.
elsif Is_Generic_Type (Root_Type (Typ)) then
return UI_From_Int (Int'Last);
@ -12719,7 +12720,20 @@ package body Sem_Util is
end if;
end if;
-- Return library level for a generic formal type (why???)
-- Return library level for a generic formal type. This is done because
-- RM(10.3.2) says that "The statically deeper relationship does not
-- apply to ... a descendant of a generic formal type". Rather than
-- checking at each point where a static accessibility check is
-- performed to see if we are dealing with a formal type, this rule is
-- implemented by having Type_Access_Level and Deepest_Type_Access_Level
-- return extreme values for a formal type; Deepest_Type_Access_Level
-- returns Int'Last. By calling the appropriate function from among the
-- two, we ensure that the static accessibility check will pass if we
-- happen to run into a formal type. More specifically, we should call
-- Deepest_Type_Access_Level instead of Type_Access_Level whenever the
-- call occurs as part of a static accessibility check and the error
-- case is the case where the type's level is too shallow (as opposed
-- to too deep).
if Is_Generic_Type (Root_Type (Btyp)) then
return Scope_Depth (Standard_Standard);

2
gcc/ada/sinfo.adb
View file

@ -657,6 +657,7 @@ package body Sinfo is
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Expression_Function
or else NT (N).Nkind = N_Package_Body
or else NT (N).Nkind = N_Protected_Body
or else NT (N).Nkind = N_Subprogram_Body
@ -3729,6 +3730,7 @@ package body Sinfo is
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Expression_Function
or else NT (N).Nkind = N_Package_Body
or else NT (N).Nkind = N_Protected_Body
or else NT (N).Nkind = N_Subprogram_Body

3
gcc/ada/sinfo.ads
View file

@ -760,6 +760,8 @@ package Sinfo is
-- renaming declaration when it is a Renaming_As_Body. The field is Empty
-- if there is no corresponding spec, as in the case of a subprogram body
-- that serves as its own spec.
-- In Ada2012, Corresponding_Spec is set on expression functions that
-- complete a subprogram declaration.
-- Corresponding_Stub (Node3-Sem)
-- This field is present in an N_Subunit node. It holds the node in
@ -4607,6 +4609,7 @@ package Sinfo is
-- Sloc points to FUNCTION
-- Specification (Node1)
-- Expression (Node3)
-- Corresponding_Spec (Node5-Sem)
-----------------------------------
-- 6.4 Procedure Call Statement --

73
gcc/ada/sysdep.c
View file

@ -80,54 +80,6 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
#endif
/*
mode_read_text
open text file for reading
rt for DOS and Windows NT, r for Unix
mode_write_text
truncate to zero length or create text file for writing
wt for DOS and Windows NT, w for Unix
mode_append_text
append; open or create text file for writing at end-of-file
at for DOS and Windows NT, a for Unix
mode_read_binary
open binary file for reading
rb for DOS and Windows NT, r for Unix
mode_write_binary
truncate to zero length or create binary file for writing
wb for DOS and Windows NT, w for Unix
mode_append_binary
append; open or create binary file for writing at end-of-file
ab for DOS and Windows NT, a for Unix
mode_read_text_plus
open text file for update (reading and writing)
r+t for DOS and Windows NT, r+ for Unix
mode_write_text_plus
truncate to zero length or create text file for update
w+t for DOS and Windows NT, w+ for Unix
mode_append_text_plus
append; open or create text file for update, writing at end-of-file
a+t for DOS and Windows NT, a+ for Unix
mode_read_binary_plus
open binary file for update (reading and writing)
r+b for DOS and Windows NT, r+ for Unix
mode_write_binary_plus
truncate to zero length or create binary file for update
w+b for DOS and Windows NT, w+ for Unix
mode_append_binary_plus
append; open or create binary file for update, writing at end-of-file
a+b for DOS and Windows NT, a+ for Unix
Notes:
(1) Opening a file with read mode fails if the file does not exist or
@ -169,18 +121,7 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
*/
#if defined(WINNT)
static const char *mode_read_text = "rt";
static const char *mode_write_text = "wt";
static const char *mode_append_text = "at";
static const char *mode_read_binary = "rb";
static const char *mode_write_binary = "wb";
static const char *mode_append_binary = "ab";
static const char *mode_read_text_plus = "r+t";
static const char *mode_write_text_plus = "w+t";
static const char *mode_append_text_plus = "a+t";
static const char *mode_read_binary_plus = "r+b";
static const char *mode_write_binary_plus = "w+b";
static const char *mode_append_binary_plus = "a+b";
const char __gnat_text_translation_required = 1;
void
@ -261,18 +202,6 @@ __gnat_get_stack_bounds (void **base, void **limit)
#else
static const char *mode_read_text = "r";
static const char *mode_write_text = "w";
static const char *mode_append_text = "a";
static const char *mode_read_binary = "r";
static const char *mode_write_binary = "w";
static const char *mode_append_binary = "a";
static const char *mode_read_text_plus = "r+";
static const char *mode_write_text_plus = "w+";
static const char *mode_append_text_plus = "a+";
static const char *mode_read_binary_plus = "r+";
static const char *mode_write_binary_plus = "w+";
static const char *mode_append_binary_plus = "a+";
const char __gnat_text_translation_required = 0;
/* These functions do nothing in non-DOS systems. */