+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
/* 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
#ifdef VMS
-static char *to_host_path_spec (char *);
-
typedef struct _ile3
{
unsigned short len, code;
-- 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;
else
pragma Assert (Is_Enumeration_Type (Rtyp));
- if Discard_Names (Rtyp) then
+ -- 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.
- -- Emit a detailed warning in configurable run-time mode because
- -- loading RE_Null does not give a precise indication of the real
- -- issue.
+ if Discard_Names (Rtyp) then
+ Error_Msg_Name_1 := Attribute_Name (N);
- 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)));
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:
break;
case SIGBUS:
- exception = &constraint_error;
- msg = "SIGBUS";
+ exception = &storage_error;
+ msg = "SIGBUS: possible stack overflow";
break;
default:
-- 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;
-- 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;
-- 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;
-- 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);
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);
- New_Body : Node_Id;
- New_Decl : Node_Id;
+ Spec : constant Node_Id := Specification (N);
+
+ Def_Id : Entity_Id;
+ pragma Unreferenced (Def_Id);
- Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
+ Prev : Entity_Id;
-- If the expression is a completion, Prev is the entity whose
- -- declaration is completed.
+ -- declaration is completed. Def_Id is needed to analyze the spec.
+
+ New_Body : Node_Id;
+ New_Decl : Node_Id;
+ 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.
-- 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,
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);
elsif Present (Prev)
and then Comes_From_Source (Prev)
then
+ Set_Has_Completion (Prev, False);
Rewrite (N, New_Body);
Analyze (N);
else
New_Decl :=
- Make_Subprogram_Declaration (Loc,
- Specification => Specification (N));
+ Make_Subprogram_Declaration (Loc, Specification => Spec);
Rewrite (N, New_Decl);
Analyze (N);
(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);
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);
(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
(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
-- 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
-- Sloc points to FUNCTION
-- Specification (Node1)
-- Expression (Node3)
+ -- Corresponding_Spec (Node5-Sem)
-----------------------------------
-- 6.4 Procedure Call Statement --
#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
*/
#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
#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. */
projects / gcc.git / commitdiff