* sem_util.adb (Check_Expression_Against_Static_Predicate):
Mark expression as non-static if it fails static predicate check,
and issue additional warning.
2014-07-18 Pascal Obry <obry@adacore.com>
* a-witeio.adb (Put): Control translation based on
wide_text_translation_required.
* adaint.c (CurrentCCSEncoding): New variable.
* initialize.c (__gnat_initialize): On Windows initialize
CurrentCCSEncoding based on values in GNAT_CCS_ENCODING
environment variable.
* mingw32.h (CurrentCCSEncoding): New external.
(__gnat_wide_text_translation_required): Likewise.
* sysdep.c (wide_text_translation_required): New variable.
(__gnat_set_wide_text_mode): Set mode based on CurrentCCSEncoding.
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Remove global
variable Refined_States. Add global variable Matched_Items.
(Check_Dependency_Clause): Account for dependency
clauses utilizing states with visible null refinements.
(Is_Null_Refined_State): New routine.
(Match_Items): Record each successfully matched item of pragma Depends.
(Record_Item): New routine.
2014-07-18 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Update): Set
Do_Range_Check flag on a dynamic index expression used in a
component association in the argument of Update.
2014-07-18 Gary Dismukes <dismukes@adacore.com>
* einfo.ads, sem_eval.ads, sem_ch13.adb: Minor reformatting.
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Expand_Simple_Function_Return): Redo the marking
of enclosing blocks, loops and the enclosing function using a
parent-based traversal.
* exp_util.adb (Wrap_Statements_In_Block): Suppress the secondary
stack reclamation if the iterator loop contains a return statement
that uses the stack.
* sem_ch5.adb (Analyze_Loop_Statement): There is no need to
patch up the scope stack as the secondary stack management now
takes into account the enclosing function of the iterator loop.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212805
138bc75d-0d04-0410-961f-
82ee72b054a4
+2014-07-18 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb (Check_Expression_Against_Static_Predicate):
+ Mark expression as non-static if it fails static predicate check,
+ and issue additional warning.
+
+2014-07-18 Pascal Obry <obry@adacore.com>
+
+ * a-witeio.adb (Put): Control translation based on
+ wide_text_translation_required.
+ * adaint.c (CurrentCCSEncoding): New variable.
+ * initialize.c (__gnat_initialize): On Windows initialize
+ CurrentCCSEncoding based on values in GNAT_CCS_ENCODING
+ environment variable.
+ * mingw32.h (CurrentCCSEncoding): New external.
+ (__gnat_wide_text_translation_required): Likewise.
+ * sysdep.c (wide_text_translation_required): New variable.
+ (__gnat_set_wide_text_mode): Set mode based on CurrentCCSEncoding.
+
+2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Remove global
+ variable Refined_States. Add global variable Matched_Items.
+ (Check_Dependency_Clause): Account for dependency
+ clauses utilizing states with visible null refinements.
+ (Is_Null_Refined_State): New routine.
+ (Match_Items): Record each successfully matched item of pragma Depends.
+ (Record_Item): New routine.
+
+2014-07-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute, case 'Update): Set
+ Do_Range_Check flag on a dynamic index expression used in a
+ component association in the argument of Update.
+
+2014-07-18 Gary Dismukes <dismukes@adacore.com>
+
+ * einfo.ads, sem_eval.ads, sem_ch13.adb: Minor reformatting.
+
+2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch6.adb (Expand_Simple_Function_Return): Redo the marking
+ of enclosing blocks, loops and the enclosing function using a
+ parent-based traversal.
+ * exp_util.adb (Wrap_Statements_In_Block): Suppress the secondary
+ stack reclamation if the iterator loop contains a return statement
+ that uses the stack.
+ * sem_ch5.adb (Analyze_Loop_Statement): There is no need to
+ patch up the scope stack as the secondary stack management now
+ takes into account the enclosing function of the iterator loop.
+
2014-07-18 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, g-memdum.ads, i-cstrea.ads: Minor reformatting.
(File : File_Type;
Item : Wide_Character)
is
- text_translation_required : Boolean;
- for text_translation_required'Size use Character'Size;
- pragma Import (C, text_translation_required,
- "__gnat_text_translation_required");
+ wide_text_translation_required : Boolean;
+ for wide_text_translation_required'Size use Character'Size;
+ pragma Import (C, wide_text_translation_required,
+ "__gnat_wide_text_translation_required");
-- Text translation is required on Windows only. This means that the
-- console is doing translation and we do not want to do any encoding
-- here. If this boolean is set we just output the character as-is.
begin
FIO.Check_Write_Status (AP (File));
- if text_translation_required then
+ if wide_text_translation_required then
set_wide_text_mode (fileno (File.Stream));
Discard := fputwc (Wide_Character'Pos (Item), File.Stream);
else
#else
#include "mingw32.h"
-/* Current code page to use, set in initialize.c. */
+/* Current code page and CCS encoding to use, set in initialize.c. */
UINT CurrentCodePage;
+UINT CurrentCCSEncoding;
#endif
#include <sys/utime.h>
-- Defined in all types and subtypes. Set if the type (which must be
-- a discrete, real, or string subtype) has a static predicate, i.e. a
-- predicate whose expression is predicate-static. This can result from
--- use of a Predicate, Static_Predicate or Dynamic_Predicate aspect. We
+-- use of a Predicate, Static_Predicate, or Dynamic_Predicate aspect. We
-- can distinguish these cases by testing Has_Static_Predicate_Aspect
-- and Has_Dynamic_Predicate_Aspect. See description of the latter flag
-- for further information on dynamic predicates which are also static.
-- from a Predicate aspect or pragma or even from a Dynamic_Predicate
-- aspect. When we need to know the difference (e.g. to know what set of
-- check policies apply, use this flag and Has_Dynamic_Predicate_Aspect
--- to determine which case we have.
+-- to determine which case we have).
-- Has_Storage_Size_Clause (Flag23) [implementation base type only]
-- Defined in task types and access types. It is set if a Storage_Size
-- Here if secondary stack is used
else
- -- Make sure that no surrounding block will reclaim the secondary
- -- stack on which we are going to put the result. Not only may this
- -- introduce secondary stack leaks but worse, if the reclamation is
- -- done too early, then the result we are returning may get
- -- clobbered.
+ -- Prevent the reclamation of the secondary stack by all enclosing
+ -- blocks and loops as well as the related function, otherwise the
+ -- result will be reclaimed too early or even clobbered. Due to a
+ -- possible mix of internally generated blocks, source blocks and
+ -- loops, the scope stack may not be contiguous as all labels are
+ -- inserted at the top level within the related function. Instead,
+ -- perform a parent-based traversal and mark all appropriate
+ -- constructs.
declare
- S : Entity_Id;
+ P : Node_Id;
+
begin
- S := Current_Scope;
- while Ekind (S) = E_Block or else Ekind (S) = E_Loop loop
- Set_Sec_Stack_Needed_For_Return (S, True);
- S := Enclosing_Dynamic_Scope (S);
- end loop;
+ P := N;
+ while Present (P) loop
- -- The enclosing function itself must be marked as well, to
- -- prevent premature secondary stack cleanup.
+ -- Mark the label of a source or internally generated block or
+ -- loop.
- if Ekind (S) = E_Function then
- Set_Sec_Stack_Needed_For_Return (Scope_Id);
- end if;
+ if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
+ Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
+
+ -- Mark the enclosing function
+
+ elsif Nkind (P) = N_Subprogram_Body then
+ if Present (Corresponding_Spec (P)) then
+ Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
+ else
+ Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
+ end if;
+
+ -- Do not go beyond the enclosing function
+
+ exit;
+ end if;
+
+ P := Parent (P);
+ end loop;
end;
-- Optimize the case where the result is a function call. In this
-- When wrapping the statements of an iterator loop, check whether
-- the loop requires secondary stack management and if so, propagate
-- the appropriate flags to the block. This ensures that the cursor
- -- is properly cleaned up at each iteration of the loop. Management
- -- is not performed when the loop contains a return statement which
- -- also uses the secondary stack as this will destroy the result
- -- prematurely.
+ -- is properly cleaned up at each iteration of the loop.
Iter_Loop := Find_Enclosing_Iterator_Loop (Scop);
if Present (Iter_Loop) then
+ Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Iter_Loop));
+
+ -- Secondary stack reclamation is suppressed when the associated
+ -- iterator loop contains a return statement which uses the stack.
+
Set_Sec_Stack_Needed_For_Return
(Block_Id, Sec_Stack_Needed_For_Return (Iter_Loop));
- Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Iter_Loop));
end if;
return Block_Nod;
platform. On the other Operating Systems the run-time is supporting
UTF-8 natively.
+@node File content encoding
+@section File content encoding
+
+@noindent
+For text files it is possible to specify the encoding to use. This is
+controlled by the by the @samp{GNAT_CCS_ENCODING} environment
+variable. And if not set @samp{TEXT} is assumed.
+
+The possible values are those supported on Windows:
+
+@table @samp
+@item TEXT
+Translated text mode
+@item WTEXT
+Translated unicode encoding
+@item U16TEXT
+Unicode 16-bit encoding
+@item U8TEXT
+Unicode 8-bit encoding
+@end table
+
+This encoding is only supported on the Windows platform.
+
@node Open Modes
@section Open Modes
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2014, 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- *
#endif
#include "raise.h"
+#include <fcntl.h>
#ifdef __cplusplus
extern "C" {
}
}
+ /* Set current encoding for the IO. */
+ {
+ char *ccsencoding = getenv ("GNAT_CCS_ENCODING");
+
+ /* Default CCS Encoding. */
+ CurrentCCSEncoding = _O_TEXT;
+ __gnat_wide_text_translation_required = 0;
+
+ if (ccsencoding != NULL)
+ {
+ if (strcmp (ccsencoding, "U16TEXT") == 0)
+ {
+ CurrentCCSEncoding = _O_U16TEXT;
+ __gnat_wide_text_translation_required = 1;
+ }
+ else if (strcmp (ccsencoding, "TEXT") == 0)
+ {
+ CurrentCCSEncoding = _O_TEXT;
+ __gnat_wide_text_translation_required = 0;
+ }
+ else if (strcmp (ccsencoding, "WTEXT") == 0)
+ {
+ CurrentCCSEncoding = _O_WTEXT;
+ __gnat_wide_text_translation_required = 1;
+ }
+ else if (strcmp (ccsencoding, "U8TEXT") == 0)
+ {
+ CurrentCCSEncoding = _O_U8TEXT;
+ __gnat_wide_text_translation_required = 1;
+ }
+ }
+ }
+
/* Adjust gnat_argv to support Unicode characters. */
{
LPWSTR *wargv;
* *
* C Header File *
* *
- * Copyright (C) 2002-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 2002-2014, 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- *
#ifdef GNAT_UNICODE_SUPPORT
extern UINT CurrentCodePage;
+extern UINT CurrentCCSEncoding;
+extern char __gnat_wide_text_translation_required;
/* Macros to convert to/from the code page specified in CurrentCodePage. */
#define S2WSC(wstr,str,len) \
else
Analyze_And_Resolve (Index, Etype (Index_Type));
+ if not Is_OK_Static_Expression (Index) then
+ Set_Do_Range_Check (Index);
+ end if;
end if;
Next (Index);
EN : Node_Id;
begin
- -- Case where we have a predicate static aspect
+ -- Case where we have a predicate-static aspect
if PS then
-- We don't set Has_Static_Predicate_Aspect, since we can have
-- any of the three cases (Predicate, Dynamic_Predicate, or
-- Static_Predicate) generating a predicate with an expression
- -- that is predicate static. We just indicate that we have a
+ -- that is predicate-static. We just indicate that we have a
-- predicate that can be treated as static.
Set_Has_Static_Predicate (Typ);
-- First a little fiddling to get a nice location for the
-- message. If the expression is of the form (A and then B),
-- then use the left operand for the Sloc. This avoids getting
- -- confused by a call to a higher level predicate with a less
+ -- confused by a call to a higher-level predicate with a less
-- convenient source location.
EN := Expr;
is
function All_Static_Case_Alternatives (L : List_Id) return Boolean;
-- Given a list of case expression alternatives, returns True if
- -- all the alternative are static (have all static choices, and a
+ -- all the alternatives are static (have all static choices, and a
-- static expression).
function All_Static_Choices (L : List_Id) return Boolean;
- -- Returns true if all elements of the list are ok static choices
+ -- Returns true if all elements of the list are OK static choices
-- as defined below for Is_Static_Choice. Used for case expression
-- alternatives and for the right operand of a membership test.
function Is_Static_Choice (N : Node_Id) return Boolean;
-- Returns True if N represents a static choice (static subtype, or
- -- static subtype indication, or static expression or static range).
+ -- static subtype indication, or static expression, or static range).
--
-- Note that this is a bit more inclusive than we actually need
-- (in particular membership tests do not allow the use of subtype
- -- indications. But that doesn't matter, we have already checked
+ -- indications). But that doesn't matter, we have already checked
-- that the construct is legal to get this far.
function Is_Type_Ref (N : Node_Id) return Boolean;
pragma Inline (Is_Type_Ref);
- -- Returns if True if N is a reference to the type for the predicate in
+ -- Returns True if N is a reference to the type for the predicate in
-- the expression (i.e. if it is an identifier whose Chars field matches
-- the Nam given in the call). N must not be parenthesized, if the type
-- name appears in parens, this routine will return False.
-- Start of processing for Is_Predicate_Static
begin
- -- Only scalar types can be predicate static
+ -- Only scalar types can be predicate-static
if not Is_Scalar_Type (Etype (Expr)) then
return False;
-- One more test that is an implementation artifact caused by the fact
-- that we are analyzing not the original expresesion, but the generated
-- expression in the body of the predicate function. This can include
- -- refereces to inherited predicates, so that the expression we are
+ -- references to inherited predicates, so that the expression we are
-- processing looks like:
-- expression and then xxPredicate (typ (Inns))
return True;
-- That's an exhaustive list of tests, all other cases are not
- -- predicate static, so we return False.
+ -- predicate-static, so we return False.
else
return False;
Add_Block_Identifier (Block_Nod, Block_Id);
- -- Fix the loop scope once the loop statement is relocated inside
- -- the block, otherwise the loop and the block end up sharing the
- -- same parent scope.
-
- Set_Scope (Ent, Block_Id);
-
-- The expansion of iterator loops generates an iterator in order
-- to traverse the elements of a container:
function Eval_Static_Predicate_Check
(N : Node_Id;
Typ : Entity_Id) return Boolean;
- -- Evaluate a static predicate check applied to a known at compile time
- -- value N, which can be of a discrete, real or string type. The caller
+ -- Evaluate a static predicate check applied to a known-at-compile-time
+ -- value N, which can be of a discrete, real, or string type. The caller
-- has checked that a static predicate does apply to Typ.
procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean);
Depends : Node_Id;
-- The corresponding Depends pragma along with its clauses
- Refined_States : Elist_Id := No_Elist;
- -- A list containing all successfully refined states
+ Matched_Items : Elist_Id := No_Elist;
+ -- A list containing the entities of all successfully matched items
+ -- found in pragma Depends.
Refinements : List_Id := No_List;
-- The clauses of pragma Refined_Depends
-- Determine whether dependence clause Dep_Clause denotes an abstract
-- state that depends on itself (State => State).
+ function Is_Null_Refined_State (Item : Node_Id) return Boolean;
+ -- Determine whether item Item denotes an abstract state with visible
+ -- null refinement.
+
procedure Match_Items
(Dep_Item : Node_Id;
Ref_Item : Node_Id;
-- When scenario 8 is in effect, the entity of the abstract state
-- denoted by Dep_Item is added to list Refined_States.
+ procedure Record_Item (Item_Id : Entity_Id);
+ -- Store the entity of an item denoted by Item_Id in Matched_Items
+
----------------------------
-- Is_In_Out_State_Clause --
----------------------------
end if;
end Is_In_Out_State_Clause;
+ ---------------------------
+ -- Is_Null_Refined_State --
+ ---------------------------
+
+ function Is_Null_Refined_State (Item : Node_Id) return Boolean is
+ Item_Id : Entity_Id;
+
+ begin
+ if Is_Entity_Name (Item) then
+
+ -- Handle abstract views generated for limited with clauses
+
+ Item_Id := Available_View (Entity_Of (Item));
+
+ return
+ Ekind (Item_Id) = E_Abstract_State
+ and then Has_Null_Refinement (Item_Id);
+ else
+ return False;
+ end if;
+ end Is_Null_Refined_State;
+
-----------------
-- Match_Items --
-----------------
if Has_Null_Refinement (Dep_Item_Id)
and then (No (Ref_Item) or else Nkind (Ref_Item) = N_Null)
then
+ Record_Item (Dep_Item_Id);
Matched := True;
-- An abstract state with visible non-null refinement
and then Encapsulating_State (Ref_Item_Id) =
Dep_Item_Id
then
- -- Record the successfully refined state
-
- if not Contains (Refined_States, Dep_Item_Id) then
- Add_Item (Dep_Item_Id, Refined_States);
- end if;
-
+ Record_Item (Dep_Item_Id);
Matched := True;
end if;
end if;
elsif Is_Entity_Name (Ref_Item)
and then Entity_Of (Ref_Item) = Dep_Item_Id
then
+ Record_Item (Dep_Item_Id);
Matched := True;
end if;
elsif Is_Entity_Name (Ref_Item)
and then Entity_Of (Ref_Item) = Dep_Item_Id
then
+ Record_Item (Dep_Item_Id);
Matched := True;
end if;
end if;
end Match_Items;
+ -----------------
+ -- Record_Item --
+ -----------------
+
+ procedure Record_Item (Item_Id : Entity_Id) is
+ begin
+ if not Contains (Matched_Items, Item_Id) then
+ Add_Item (Item_Id, Matched_Items);
+ end if;
+ end Record_Item;
+
-- Local variables
Clause_Matched : Boolean := False;
if not Clause_Matched
and then Is_In_Out_State_Clause
and then Contains
- (Refined_States, Available_View (Entity_Of (Dep_Input)))
+ (Matched_Items, Available_View (Entity_Of (Dep_Input)))
+ then
+ Clause_Matched := True;
+ end if;
+
+ -- A clause where the input is an abstract state with visible null
+ -- refinement is implicitly matched when the output has already been
+ -- matched in a previous clause.
+
+ -- Depends => (Output => State) -- implicitly OK
+ -- Refined_State => (State => null)
+ -- Refined_Depends => (Output => ...)
+
+ if not Clause_Matched
+ and then Is_Null_Refined_State (Dep_Input)
+ and then Is_Entity_Name (Dep_Output)
+ and then Contains
+ (Matched_Items, Available_View (Entity_Of (Dep_Output)))
+ then
+ Clause_Matched := True;
+ end if;
+
+ -- A clause where the output is an abstract state with visible null
+ -- refinement is implicitly matched when the input has already been
+ -- matched in a previous clause.
+
+ -- Depends => (State => Input) -- implicitly OK
+ -- Refined_State => (State => null)
+ -- Refined_Depends => (... => Input)
+
+ if not Clause_Matched
+ and then Is_Null_Refined_State (Dep_Output)
+ and then Is_Entity_Name (Dep_Input)
+ and then Contains
+ (Matched_Items, Available_View (Entity_Of (Dep_Input)))
then
Clause_Matched := True;
end if;
else
Error_Msg_NE
("??static expression fails predicate check on &", Expr, Typ);
+
+ -- We now reset the static expression indication on the expression
+ -- since it is no longer static if it fails a predicate test. We
+ -- do not do this if the predicate was officially dynamic, since
+ -- dynamic predicates don't affect legality in this manner.
+
+ if not Has_Dynamic_Predicate_Aspect (Typ) then
+ Error_Msg_N
+ ("\??expression is no longer considered static", Expr);
+ Set_Is_Static_Expression (Expr, False);
+ end if;
end if;
end if;
end Check_Expression_Against_Static_Predicate;
#if defined (WINNT) || defined (__CYGWIN__)
const char __gnat_text_translation_required = 1;
+char __gnat_wide_text_translation_required = 0;
#ifdef __CYGWIN__
#define WIN_SETMODE setmode
void
__gnat_set_wide_text_mode (int handle)
{
- WIN_SETMODE (handle, _O_U16TEXT);
+ WIN_SETMODE (handle, CurrentCCSEncoding);
}
#ifdef __CYGWIN__
#else
const char __gnat_text_translation_required = 0;
+const char __gnat_wide_text_translation_required = 0;
/* These functions do nothing in non-DOS systems. */
projects / thirdparty / gcc.git / commitdiff
