Skip to content

R
riscv-gcc-1
Commit f6b5dc8e by Arnaud Charlet
Options

[multiple changes] 

2010-10-25  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through
	non-static predicate, since we agree not to allow this.
	(Expand_Predicated_Loop): Properlay handle false predicate (null
	list in Static_Predicate field.
	* sem_ch13.adb (Build_Static_Predicate): Extensive changes to clean up
	handling of more general predicate forms.

2010-10-25  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb, sem_util.adb: Minor reformatting.
	* sem_ch8.adb (Find_Selected_Component): Allow selection from instance
	of type in predicate or invariant expression.

2010-10-25  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_stat_to_attr): Can set the timestamp on Windows now.
	(f2t): New routine.
	(__gnat_stat): Rewrite Win32 version.

From-SVN: r165919
parent 66150d01
Showing with 274 additions and 217 deletions
gcc/ada/ChangeLog
2010-10-25 Robert Dewar <dewar@adacore.com>
* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through
non-static predicate, since we agree not to allow this.
(Expand_Predicated_Loop): Properlay handle false predicate (null
list in Static_Predicate field.
* sem_ch13.adb (Build_Static_Predicate): Extensive changes to clean up
handling of more general predicate forms.
2010-10-25 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb, sem_util.adb: Minor reformatting.
* sem_ch8.adb (Find_Selected_Component): Allow selection from instance
of type in predicate or invariant expression.
2010-10-25 Pascal Obry <obry@adacore.com>
* adaint.c (__gnat_stat_to_attr): Can set the timestamp on Windows now.
(f2t): New routine.
(__gnat_stat): Rewrite Win32 version.
2010-10-25 Robert Dewar <dewar@adacore.com>
* sem_warn.adb, einfo.ads, exp_ch4.adb: Minor comment fix
* sem_case.adb: Comment clarification for loops through false
predicates.
......
gcc/ada/adaint.c
......@@ -1112,8 +1112,6 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
#endif
#if !defined (_WIN32) || defined (RTX)
/* on Windows requires extra system call, see __gnat_file_time_name_attr */
if (ret != 0) {
attr->timestamp = (OS_Time)-1;
} else {
......@@ -1124,8 +1122,6 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
attr->timestamp = (OS_Time)statbuf.st_mtime;
#endif
}
#endif
}
/****************************************************************
......@@ -1345,6 +1341,19 @@ win32_filetime (HANDLE h)
return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
return (time_t) 0;
}
/* As above but starting from a FILETIME. */
static void f2t (const FILETIME *ft, time_t *t)
{
union
{
FILETIME ft_time;
unsigned long long ull_time;
} t_write;
t_write.ft_time = *ft;
*t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
}
#endif
/* Return a GNAT time stamp given a file name. */
......@@ -1687,15 +1696,10 @@ int
__gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
{
#ifdef __MINGW32__
/* Under Windows the directory name for the stat function must not be
terminated by a directory separator except if just after a drive name
or with UNC path without directory (only the name of the shared
resource), for example: \\computer\share\ */
WIN32_FILE_ATTRIBUTE_DATA fad;
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
int name_len, k;
TCHAR last_char;
int dirsep_count = 0;
int name_len;
BOOL res;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
name_len = _tcslen (wname);
......@@ -1703,29 +1707,43 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
if (name_len > GNAT_MAX_PATH_LEN)
return -1;
last_char = wname[name_len - 1];
while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
{
wname[name_len - 1] = _T('\0');
name_len--;
last_char = wname[name_len - 1];
ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
if (res == FALSE)
switch (GetLastError()) {
case ERROR_ACCESS_DENIED:
case ERROR_SHARING_VIOLATION:
case ERROR_LOCK_VIOLATION:
case ERROR_SHARING_BUFFER_EXCEEDED:
return EACCES;
case ERROR_BUFFER_OVERFLOW:
return ENAMETOOLONG;
case ERROR_NOT_ENOUGH_MEMORY:
return ENOMEM;
default:
return ENOENT;
}
/* Count back-slashes. */
f2t (&fad.ftCreationTime, &statbuf->st_ctime);
f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
statbuf->st_size = (off_t)fad.nFileSizeLow;
for (k=0; k<name_len; k++)
if (wname[k] == _T('\\') || wname[k] == _T('/'))
dirsep_count++;
/* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
statbuf->st_mode = S_IREAD;
/* Only a drive letter followed by ':', we must add a directory separator
for the stat routine to work properly. */
if ((name_len == 2 && wname[1] == _T(':'))
|| (name_len > 3 && wname[0] == _T('\\') && wname[1] == _T('\\')
&& dirsep_count == 3))
_tcscat (wname, _T("\\"));
if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
statbuf->st_mode |= S_IFDIR;
else
statbuf->st_mode |= S_IFREG;
return _tstat (wname, (struct _stat *)statbuf);
if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
statbuf->st_mode |= S_IWRITE;
return 0;
#else
return GNAT_STAT (name, statbuf);
......
gcc/ada/exp_ch5.adb
......@@ -3001,7 +3001,7 @@ package body Exp_Ch5 is
if No (Isc) then
null;
-- Case of for loop (Loop_Parameter_Specfication present)
-- Case of for loop (Loop_Parameter_Specification present)
-- Note: we do not have to worry about validity checking of the for loop
-- range bounds here, since they were frozen with constant declarations
......@@ -3215,26 +3215,20 @@ package body Exp_Ch5 is
Stmts : constant List_Id := Statements (N);
begin
-- Case of iteration over non-static predicate. In this case we
-- generate the sequence:
-- for J in Ltype'First .. Ltype'Last loop
-- if Ltype_Predicate_Function (J) then
-- body;
-- end if;
-- end loop;
-- Case of iteration over non-static predicate, should not be possible
-- since this is not allowed by the semantics and should have been
-- caught during analysis of the loop statement.
if No (Stat) then
raise Program_Error;
-- The analyzer already expanded the First/Last, so all we have
-- to do is wrap the body within the predicate function test.
-- If the predicate list is empty, that corresponds to a predicate of
-- False, in which case the loop won't run at all, and we rewrite the
-- entire loop as a null statement.
Set_Statements (N, New_List (
Make_If_Statement (Loc,
Condition =>
Make_Predicate_Call (Ltype, New_Occurrence_Of (Loop_Id, Loc)),
Then_Statements => Stmts)));
Analyze (First (Statements (N)));
elsif Is_Empty_List (Stat) then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
-- For expansion over a static predicate we generate the following
......
gcc/ada/sem_ch13.adb
......@@ -94,16 +94,16 @@ package body Sem_Ch13 is
(Typ : Entity_Id;
Expr : Node_Id;
Nam : Name_Id);
-- Given a predicated type Typ, whose predicate expression is Expr, tests
-- if Expr is a static predicate, and if so, builds the predicate range
-- list. Nam is the name of the argument to the predicate function.
-- Occurrences of the type name in the predicate expression have been
-- replaced by identifer references to this name, which is unique, so any
-- identifier with Chars matching Nam must be a reference to the type. If
-- the predicate is non-static, this procedure returns doing nothing. If
-- the predicate is static, then the corresponding predicate list is stored
-- in Static_Predicate (Typ), and the Expr is rewritten as a canonicalized
-- membership operation.
-- Given a predicated type Typ, where Typ is a discrete static subtype,
-- whose predicate expression is Expr, tests if Expr is a static predicate,
-- and if so, builds the predicate range list. Nam is the name of the one
-- argument to the predicate function. Occurrences of the type name in the
-- predicate expression have been replaced by identifer references to this
-- name, which is unique, so any identifier with Chars matching Nam must be
-- a reference to the type. If the predicate is non-static, this procedure
-- returns doing nothing. If the predicate is static, then the predicate
-- list is stored in Static_Predicate (Typ), and the Expr is rewritten as
-- a canonicalized membership operation.
function Get_Alignment_Value (Expr : Node_Id) return Uint;
-- Given the expression for an alignment value, returns the corresponding
......@@ -4045,7 +4045,13 @@ package body Sem_Ch13 is
-- Deal with static predicate case
Build_Static_Predicate (Typ, Expr, Object_Name);
if Ekind_In (Typ, E_Enumeration_Subtype,
E_Modular_Integer_Subtype,
E_Signed_Integer_Subtype)
and then Is_Static_Subtype (Typ)
then
Build_Static_Predicate (Typ, Expr, Object_Name);
end if;
-- Build function declaration
......@@ -4115,8 +4121,15 @@ package body Sem_Ch13 is
Non_Static : exception;
-- Raised if something non-static is found
TLo, THi : Uint;
-- Low bound and high bound values of static subtype of Typ
Btyp : constant Entity_Id := Base_Type (Typ);
BLo : constant Uint := Expr_Value (Type_Low_Bound (Btyp));
BHi : constant Uint := Expr_Value (Type_High_Bound (Btyp));
-- Low bound and high bound value of base type of Typ
TLo : constant Uint := Expr_Value (Type_Low_Bound (Typ));
THi : constant Uint := Expr_Value (Type_High_Bound (Typ));
-- Low bound and high bound values of static subtype Typ
type REnt is record
Lo, Hi : Uint;
......@@ -4128,15 +4141,20 @@ package body Sem_Ch13 is
type RList is array (Nat range <>) of REnt;
-- A list of ranges. The ranges are sorted in increasing order,
-- and are disjoint (there is a gap of at least one value between
-- each range in the table).
-- each range in the table). A value is in the set of ranges in
-- Rlist if it lies within one of these ranges
Null_Range : constant RList := RList'(1 .. 0 => REnt'(No_Uint, No_Uint));
True_Range : RList renames Null_Range;
-- Constant representing null list of ranges, used to represent a
-- predicate of True, since there are no ranges to be satisfied.
False_Range : constant RList :=
RList'(1 .. 0 => REnt'(No_Uint, No_Uint));
-- An empty set of ranges represents a range list that can never be
-- satisfied, since there are no ranges in which the value could lie,
-- so it does not lie in any of them. False_Range is a canonical value
-- for this empty set, but general processing should test for an Rlist
-- with length zero (see Is_False predicate), since other null ranges
-- may appear which must be treated as False.
False_Range : constant RList := RList'(1 => REnt'(Uint_1, Uint_0));
-- Range representing false
True_Range : constant RList := RList'(1 => REnt'(BLo, BHi));
-- Range representing True, value must be in the base range
function "and" (Left, Right : RList) return RList;
-- And's together two range lists, returning a range list. This is
......@@ -4153,16 +4171,27 @@ package body Sem_Ch13 is
function Build_Val (V : Uint) return Node_Id;
-- Return an analyzed N_Identifier node referencing this value, suitable
-- for use as an entry in the Static_Predicate list.
-- for use as an entry in the Static_Predicate list. This node is typed
-- with the base type.
function Build_Range (Lo, Hi : Uint) return Node_Id;
-- Return an analyzed N_Range node referencing this range, suitable
-- for use as an entry in the Static_Predicate list.
-- for use as an entry in the Static_Predicate list. This node is typed
-- with the base type.
function Get_RList (Exp : Node_Id) return RList;
-- This is a recursive routine that converts the given expression into
-- a list of ranges, suitable for use in building the static predicate.
function Is_False (R : RList) return Boolean;
pragma Inline (Is_False);
-- Returns True if the given range list is empty, and thus represents
-- a False list of ranges that can never be satsified.
function Is_True (R : RList) return Boolean;
-- Returns True if R trivially represents the True predicate by having
-- a single range from BLo to BHi.
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
......@@ -4207,21 +4236,15 @@ package body Sem_Ch13 is
begin
-- If either range is True, return the other
if Left = True_Range then
if Is_True (Left) then
return Right;
elsif Right = True_Range then
elsif Is_True (Right) then
return Left;
end if;
-- If either range is False, return False
if Left = False_Range or else Right = False_Range then
return False_Range;
end if;
-- If either range is empty, return False
if Left'Length = 0 or else Right'Length = 0 then
if Is_False (Left) or else Is_False (Right) then
return False_Range;
end if;
......@@ -4267,18 +4290,13 @@ package body Sem_Ch13 is
SRight := SRight + 1;
end if;
-- If either operand is empty, that's the only entry
-- Compute result by concatenating this first entry with the "and"
-- of the remaining parts of the left and right operands. Note that
-- if either of these is empty, "and" will yield empty, so that we
-- will end up with just Fent, which is what we want in that case.
if SLeft > Left'Last or else SRight > Right'Last then
return RList'(1 => FEnt);
-- Else compute and of remaining entries and concatenate
else
return
FEnt &
(Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
end if;
return
FEnt & (Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
end "and";
-----------
......@@ -4289,13 +4307,13 @@ package body Sem_Ch13 is
begin
-- Return True if False range
if Right = False_Range then
if Is_False (Right) then
return True_Range;
end if;
-- Return False if True range
if Right'Length = 0 then
if Is_True (Right) then
return False_Range;
end if;
......@@ -4340,100 +4358,76 @@ package body Sem_Ch13 is
----------
function "or" (Left, Right : RList) return RList is
FEnt : REnt;
-- First range of result
SLeft : Nat := Left'First;
-- Start of rest of left entries
SRight : Nat := Right'First;
-- Start of rest of right entries
begin
-- If either range is True, return True
if Left = True_Range or else Right = True_Range then
if Is_True (Left) or else Is_True (Right) then
return True_Range;
end if;
-- If either range is False, return the other
-- If either range is False (empty), return the other
if Left = False_Range then
if Is_False (Left) then
return Right;
elsif Right = False_Range then
elsif Is_False (Right) then
return Left;
end if;
-- If either operand is null, return the other one
-- Initialize result first entry from left or right operand
-- depending on which starts with the lower range.
if Left'Length = 0 then
return Right;
elsif Right'Length = 0 then
return Left;
if Left (SLeft).Lo < Right (SRight).Lo then
FEnt := Left (SLeft);
SLeft := SLeft + 1;
else
FEnt := Right (SRight);
SRight := SRight + 1;
end if;
-- Now we have two non-null ranges
declare
FEnt : REnt;
-- First range of result
SLeft : Nat := Left'First;
-- Start of rest of left entries
-- This loop eats ranges from left and right operands that
-- are contiguous with the first range we are gathering.
SRight : Nat := Right'First;
-- Start of rest of right entries
begin
-- Initialize result first entry from left or right operand
-- depending on which starts with the lower range.
loop
-- Eat first entry in left operand if contiguous or
-- overlapped by gathered first operand of result.
if Left (SLeft).Lo < Right (SRight).Lo then
FEnt := Left (SLeft);
if SLeft <= Left'Last
and then Left (SLeft).Lo <= FEnt.Hi + 1
then
FEnt.Hi := UI_Max (FEnt.Hi, Left (SLeft).Hi);
SLeft := SLeft + 1;
else
FEnt := Right (SRight);
SRight := SRight + 1;
end if;
-- This loop eats ranges from left and right operands that
-- are contiguous with the first range we are gathering.
loop
-- Eat first entry in left operand if contiguous or
-- overlapped by gathered first operand of result.
if SLeft <= Left'Last
and then Left (SLeft).Lo <= FEnt.Hi + 1
then
FEnt.Hi := UI_Max (FEnt.Hi, Left (SLeft).Hi);
SLeft := SLeft + 1;
-- Eat first entry in right operand if contiguous or
-- overlapped by gathered right operand of result.
elsif SRight <= Right'Last
and then Right (SRight).Lo <= FEnt.Hi + 1
then
FEnt.Hi := UI_Max (FEnt.Hi, Right (SRight).Hi);
SRight := SRight + 1;
elsif SRight <= Right'Last
and then Right (SRight).Lo <= FEnt.Hi + 1
then
FEnt.Hi := UI_Max (FEnt.Hi, Right (SRight).Hi);
SRight := SRight + 1;
-- All done if no more entries to eat!
else
exit;
end if;
end loop;
-- If left operand now empty, concatenate our new entry to right
if SLeft > Left'Last then
return FEnt & Right (SRight .. Right'Last);
-- If right operand now empty, concatenate our new entry to left
elsif SRight > Right'Last then
return FEnt & Left (SLeft .. Left'Last);
-- Otherwise, compute or of what is left and concatenate
else
return
FEnt &
(Left (SLeft .. Left'Last) or Right (SRight .. Right'Last));
exit;
end if;
end;
end loop;
-- Obtain result as the first entry we just computed, concatenated
-- to the "or" of the remaining results (if one operand is empty,
-- this will just concatenate with the other
return
FEnt & (Left (SLeft .. Left'Last) or Right (SRight .. Right'Last));
end "or";
-----------------
......@@ -4450,7 +4444,7 @@ package body Sem_Ch13 is
Make_Range (Loc,
Low_Bound => Build_Val (Lo),
High_Bound => Build_Val (Hi));
Set_Etype (Result, Typ);
Set_Etype (Result, Btyp);
Set_Analyzed (Result);
return Result;
end if;
......@@ -4470,7 +4464,7 @@ package body Sem_Ch13 is
Result := Make_Integer_Literal (Loc, Intval => V);
end if;
Set_Etype (Result, Typ);
Set_Etype (Result, Btyp);
Set_Is_Static_Expression (Result);
Set_Analyzed (Result);
return Result;
......@@ -4489,15 +4483,12 @@ package body Sem_Ch13 is
if Is_OK_Static_Expression (Exp) then
-- For False, return impossible range, which will always fail
-- For False
if Expr_Value (Exp) = 0 then
return False_Range;
-- For True, null range
else
return Null_Range;
return True_Range;
end if;
end if;
......@@ -4566,20 +4557,20 @@ package body Sem_Ch13 is
return RList'(1 => REnt'(Val, Val));
when N_Op_Ge =>
return RList'(1 => REnt'(Val, THi));
return RList'(1 => REnt'(Val, BHi));
when N_Op_Gt =>
return RList'(1 => REnt'(Val + 1, THi));
return RList'(1 => REnt'(Val + 1, BHi));
when N_Op_Le =>
return RList'(1 => REnt'(TLo, Val));
return RList'(1 => REnt'(BLo, Val));
when N_Op_Lt =>
return RList'(1 => REnt'(TLo, Val - 1));
return RList'(1 => REnt'(BLo, Val - 1));
when N_Op_Ne =>
return RList'(REnt'(TLo, Val - 1),
REnt'(Val + 1, THi));
return RList'(REnt'(BLo, Val - 1),
REnt'(Val + 1, BHi));
when others =>
raise Program_Error;
......@@ -4633,6 +4624,14 @@ package body Sem_Ch13 is
when N_Qualified_Expression =>
return Get_RList (Expression (Exp));
-- Xor operator
when N_Op_Xor =>
return (Get_RList (Left_Opnd (Exp))
and not Get_RList (Right_Opnd (Exp)))
or (Get_RList (Right_Opnd (Exp))
and not Get_RList (Left_Opnd (Exp)));
-- Any other node type is non-static
when others =>
......@@ -4654,6 +4653,26 @@ package body Sem_Ch13 is
end if;
end Hi_Val;
--------------
-- Is_False --
--------------
function Is_False (R : RList) return Boolean is
begin
return R'Length = 0;
end Is_False;
-------------
-- Is_True --
-------------
function Is_True (R : RList) return Boolean is
begin
return R'Length = 1
and then R (R'First).Lo = BLo
and then R (R'First).Hi = BHi;
end Is_True;
-----------------
-- Is_Type_Ref --
-----------------
......@@ -4789,22 +4808,6 @@ package body Sem_Ch13 is
-- Start of processing for Build_Static_Predicate
begin
-- Immediately non-static if our subtype is non static, or we
-- do not have an appropriate discrete subtype in the first place.
if not Ekind_In (Typ, E_Enumeration_Subtype,
E_Modular_Integer_Subtype,
E_Signed_Integer_Subtype)
or else not Is_Static_Subtype (Typ)
then
return;
end if;
-- Get bounds of the type
TLo := Expr_Value (Type_Low_Bound (Typ));
THi := Expr_Value (Type_High_Bound (Typ));
-- Now analyze the expression to see if it is a static predicate
declare
......@@ -4818,18 +4821,45 @@ package body Sem_Ch13 is
-- Ranges array, we just have raw ranges, these must be converted
-- to properly typed and analyzed static expressions or range nodes.
-- Note: here we limit ranges to the ranges of the subtype, so that
-- a predicate is always false for values outside the subtype. That
-- seems fine, such values are invalid anyway, and considering them
-- to fail the predicate seems allowed and friendly, and furthermore
-- simplifies processing for case statements and loops.
Plist := New_List;
for J in Ranges'Range loop
declare
Lo : constant Uint := Ranges (J).Lo;
Hi : constant Uint := Ranges (J).Hi;
Lo : Uint := Ranges (J).Lo;
Hi : Uint := Ranges (J).Hi;
begin
if Lo = Hi then
Append_To (Plist, Build_Val (Lo));
-- Ignore completely out of range entry
if Hi < TLo or else Lo > THi then
null;
-- Otherwise process entry
else
Append_To (Plist, Build_Range (Lo, Hi));
-- Adjust out of range value to subtype range
if Lo < TLo then
Lo := TLo;
end if;
if Hi > THi then
Hi := THi;
end if;
-- Convert range into required form
if Lo = Hi then
Append_To (Plist, Build_Val (Lo));
else
Append_To (Plist, Build_Range (Lo, Hi));
end if;
end if;
end;
end loop;
......@@ -4865,21 +4895,12 @@ package body Sem_Ch13 is
Next (Old_Node);
end loop;
-- If empty list, replace by True
-- If empty list, replace by False
if Is_Empty_List (New_Alts) then
Rewrite (Expr, New_Occurrence_Of (Standard_True, Loc));
-- If singleton list, replace by simple membership test
elsif List_Length (New_Alts) = 1 then
Rewrite (Expr,
Make_In (Loc,
Left_Opnd => Make_Identifier (Loc, Nam),
Right_Opnd => Relocate_Node (First (New_Alts)),
Alternatives => No_List));
Rewrite (Expr, New_Occurrence_Of (Standard_False, Loc));
-- If more than one range, replace by set membership test
-- Else replace by set membership test
else
Rewrite (Expr,
......
gcc/ada/sem_ch4.adb
......@@ -2440,9 +2440,8 @@ package body Sem_Ch4 is
end loop;
end if;
-- If not a range, it can be a subtype mark, or else it is
-- a degenerate membership test with a singleton value, i.e.
-- a test for equality.
-- If not a range, it can be a subtype mark, or else it is a degenerate
-- membership test with a singleton value, i.e. a test for equality.
else
Analyze (R);
......@@ -2469,8 +2468,8 @@ package body Sem_Ch4 is
return;
else
-- in previous version of the language this is an error
-- that will be diagnosed below.
-- In previous version of the language this is an error that will
-- be diagnosed below.
Find_Type (R);
end if;
......
gcc/ada/sem_ch8.adb
......@@ -5479,6 +5479,11 @@ package body Sem_Ch8 is
Analyze_Selected_Component (N);
-- Reference to type name in predicate/invariant expression
elsif OK_To_Reference (Etype (P)) then
Analyze_Selected_Component (N);
elsif Is_Appropriate_For_Entry_Prefix (P_Type)
and then not In_Open_Scopes (P_Name)
and then (not Is_Concurrent_Type (Etype (P_Name))
......@@ -5490,10 +5495,10 @@ package body Sem_Ch8 is
Analyze_Selected_Component (N);
elsif (In_Open_Scopes (P_Name)
and then Ekind (P_Name) /= E_Void
and then not Is_Overloadable (P_Name))
and then Ekind (P_Name) /= E_Void
and then not Is_Overloadable (P_Name))
or else (Is_Concurrent_Type (Etype (P_Name))
and then In_Open_Scopes (Etype (P_Name)))
and then In_Open_Scopes (Etype (P_Name)))
then
-- Prefix denotes an enclosing loop, block, or task, i.e. an
-- enclosing construct that is not a subprogram or accept.
......@@ -5508,8 +5513,7 @@ package body Sem_Ch8 is
-- The subprogram may be a renaming (of an enclosing scope) as
-- in the case of the name of the generic within an instantiation.
if (Ekind (P_Name) = E_Procedure
or else Ekind (P_Name) = E_Function)
if Ekind_In (P_Name, E_Procedure, E_Function)
and then Present (Alias (P_Name))
and then Is_Generic_Instance (Alias (P_Name))
then
......
gcc/ada/sem_util.adb
......@@ -1226,7 +1226,7 @@ package body Sem_Util is
return;
end if;
-- Ada 2012 AI04-0144-2 : dangerous order dependence. Actuals in nested
-- Ada 2012 AI04-0144-2: Dangerous order dependence. Actuals in nested
-- calls within a construct have been collected. If one of them is
-- writable and overlaps with another one, evaluation of the enclosing
-- construct is nondeterministic. This is illegal in Ada 2012, but is
......@@ -1278,6 +1278,7 @@ package body Sem_Util is
procedure Check_Potentially_Blocking_Operation (N : Node_Id) is
S : Entity_Id;
begin
-- N is one of the potentially blocking operations listed in 9.5.1(8).
-- When pragma Detect_Blocking is active, the run time will raise
......@@ -1294,7 +1295,6 @@ package body Sem_Util is
if Is_Protected_Type (S) then
Error_Msg_N
("potentially blocking operation in protected operation?", N);
return;
end if;
......
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