+2011-12-12 Gary Dismukes <dismukes@adacore.com>
+
+ * freeze.adb (Freeze_Expression): Allow freezing of static
+ scalar subtypes that are prefixes of an attribute, even if not
+ yet marked static. Such attributes will get marked as static
+ later in Eval_Attribute (as called from Resolve_Attribute).
+ * sem_attr.adb (Eval_Attribute): Remove wrong code that does an
+ early return for attribute prefixes that are unfrozen source-level
+ types. This code was incorrectly bypassing folding of unfrozen
+ static subtype attributes in default expressions (the executable
+ example in the now-deleted comment was in fact illegal).
+
+2011-12-12 Robert Dewar <dewar@adacore.com>
+
+ * a-coinve.adb, sem_res.adb, prj-nmsc.adb, a-cobove.adb, a-convec.adb,
+ gnatls.adb, sem_ch13.adb, prj-env.adb, prj-env.ads: Minor reformatting.
+
+2011-12-12 Tristan Gingold <gingold@adacore.com>
+
+ * gsocket.h: Adjust previous patch.
+
2011-12-12 Thomas Quinot <quinot@adacore.com>
* exp_disp.adb: Minor reformatting.
-- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function.
- -- When the Index component is No_Index, this means the iterator object
- -- was constructed without a start expression, in which case the
+ -- When the Index component is No_Index, this means the iterator
+ -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward
-- iterator).
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Index component isn't No_Index, the iterator object was
- -- constructed with a start expression, that specifies the position from
- -- which the (forward) partial iteration begins.
+ -- Otherwise, this is iteration over a partial sequence of items.
+ -- When the Index component isn't No_Index, the iterator object was
+ -- constructed with a start expression, that specifies the position
+ -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then
return First (Object.Container.all);
-- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function.
- -- When the Index component is No_Index, this means the iterator object
- -- was constructed without a start expression, in which case the
+ -- When the Index component is No_Index, this means the iterator
+ -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward
-- iterator).
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Index component isn't No_Index, the iterator object was
- -- constructed with a start expression, that specifies the position from
- -- which the (forward) partial iteration begins.
+ -- Otherwise, this is iteration over a partial sequence of items.
+ -- When the Index component isn't No_Index, the iterator object was
+ -- constructed with a start expression, that specifies the position
+ -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then
return First (Object.Container.all);
-- is a partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
- -- the start position has the same value irrespective of whether this is
- -- a forward or reverse iteration.
+ -- the start position has the same value irrespective of whether this
+ -- is a forward or reverse iteration.
return It : constant Iterator :=
(Limited_Controlled with
-- The value of the iterator object's Index component influences the
-- behavior of the Last (and First) selector function.
- -- When the Index component is No_Index, this means the iterator object
- -- was constructed without a start expression, in which case the
+ -- When the Index component is No_Index, this means the iterator
+ -- object was constructed without a start expression, in which case the
-- (reverse) iteration starts from the (logical) beginning of the entire
-- sequence (corresponding to Container.Last, for a reverse iterator).
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Index component is not No_Index, the iterator object was
- -- constructed with a start expression, that specifies the position from
- -- which the (reverse) partial iteration begins.
+ -- Otherwise, this is iteration over a partial sequence of items.
+ -- When the Index component is not No_Index, the iterator object was
+ -- constructed with a start expression, that specifies the position
+ -- from which the (reverse) partial iteration begins.
if Object.Index = No_Index then
return Last (Object.Container.all);
-- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function.
- -- When the Index component is No_Index, this means the iterator object
- -- was constructed without a start expression, in which case the
+ -- When the Index component is No_Index, this means the iterator
+ -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward
-- iterator).
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Index component isn't No_Index, the iterator object was
- -- constructed with a start expression, that specifies the position from
- -- which the (forward) partial iteration begins.
+ -- Otherwise, this is iteration over a partial sequence of items.
+ -- When the Index component isn't No_Index, the iterator object was
+ -- constructed with a start expression, that specifies the position
+ -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then
return First (Object.Container.all);
-- is a partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
- -- the start position has the same value irrespective of whether this is
- -- a forward or reverse iteration.
+ -- the start position has the same value irrespective of whether this
+ -- is a forward or reverse iteration.
return It : constant Iterator :=
(Limited_Controlled with
-- The value of the iterator object's Index component influences the
-- behavior of the Last (and First) selector function.
- -- When the Index component is No_Index, this means the iterator object
- -- was constructed without a start expression, in which case the
+ -- When the Index component is No_Index, this means the iterator
+ -- object was constructed without a start expression, in which case the
-- (reverse) iteration starts from the (logical) beginning of the entire
-- sequence (corresponding to Container.Last, for a reverse iterator).
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Index component is not No_Index, the iterator object was
- -- constructed with a start expression, that specifies the position from
- -- which the (reverse) partial iteration begins.
+ -- Otherwise, this is iteration over a partial sequence of items.
+ -- When the Index component is not No_Index, the iterator object was
+ -- constructed with a start expression, that specifies the position
+ -- from which the (reverse) partial iteration begins.
if Object.Index = No_Index then
return Last (Object.Container.all);
-- If expression is non-static, then it does not freeze in a default
-- expression, see section "Handling of Default Expressions" in the
- -- spec of package Sem for further details. Note that we have to
- -- make sure that we actually have a real expression (if we have
- -- a subtype indication, we can't test Is_Static_Expression!)
+ -- spec of package Sem for further details. Note that we have to make
+ -- sure that we actually have a real expression (if we have a subtype
+ -- indication, we can't test Is_Static_Expression!) However, we exclude
+ -- the case of the prefix of an attribute of a static scalar subtype
+ -- from this early return, because static subtype attributes should
+ -- always cause freezing, even in default expressions, but the attribute
+ -- may not have been marked as static yet (because in Resolve_Attribute,
+ -- the call to Eval_Attribute follows the call of Freeze_Expression on
+ -- the prefix).
if In_Spec_Exp
and then Nkind (N) in N_Subexpr
and then not Is_Static_Expression (N)
+ and then (Nkind (Parent (N)) /= N_Attribute_Reference
+ or else not (Is_Entity_Name (N)
+ and then Is_Type (Entity (N))
+ and then Is_Static_Subtype (Entity (N))))
then
return;
end if;
procedure Search_RTS (Name : String) is
Src_Path : String_Ptr;
Lib_Path : String_Ptr;
- -- Pathes for source and include subdirs
+ -- Paths for source and include subdirs
Rts_Full_Path : String_Access;
-- Full path for RTS project
+
begin
-- Try to find the RTS
if Lib_Path /= null then
Osint.Fail ("RTS path not valid: missing adainclude directory");
-
elsif Src_Path /= null then
Osint.Fail ("RTS path not valid: missing adalib directory");
-
end if;
- -- Try to find the RTS on the project path. First setup the project
- -- path.
+ -- Try to find the RTS on the project path. First setup the project path
Initialize_Default_Project_Path
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
+
if Rts_Full_Path /= null then
+
-- Directory name was found on the project path. Look for the
-- include subdir(s).
- Src_Path := Get_RTS_Search_Dir (Name, Include);
+ Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
+
if Src_Path /= null then
Add_Search_Dirs (Src_Path, Include);
return;
end if;
end if;
- Osint.Fail ("RTS path not valid: missing " &
- "adainclude and adalib directories");
+ Osint.Fail
+ ("RTS path not valid: missing adainclude and adalib directories");
end Search_RTS;
-------------------
#include <windows.h>
#elif defined(VMS)
+/* Allow a large number of fds for select. */
#define FD_SETSIZE 4096
-#include <sys/types.h>
-#include <sys/time.h>
#ifndef IN_RTS
-/* These DEC C headers are not available when building with GCC */
-#include <in.h>
+/* These DEC C headers are not available when building with GCC. Order is
+ important. */
+#include <time.h>
#include <tcp.h>
+#include <in.h>
#include <ioctl.h>
#include <netdb.h>
#endif
-- Get_Runtime_Path --
----------------------
- function Get_Runtime_Path (Self : Project_Search_Path; Name : String)
- return String_Access is
+ function Get_Runtime_Path
+ (Self : Project_Search_Path;
+ Name : String) return String_Access
+ is
function Is_Base_Name (Path : String) return Boolean;
-- Returns True if Path has no directory separator
+ ------------------
+ -- Is_Base_Name --
+ ------------------
+
function Is_Base_Name (Path : String) return Boolean is
begin
- for I in Path'Range loop
- if Path (I) = Directory_Separator or else Path (I) = '/' then
+ for J in Path'Range loop
+ if Path (J) = Directory_Separator or else Path (J) = '/' then
return False;
end if;
end loop;
+
return True;
end Is_Base_Name;
function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
(Check_Filename => Is_Directory);
+
+ -- Start of processing for Get_Runtime_Path
+
begin
if not Is_Base_Name (Name) then
return Find_Rts_In_Path (Self, Name);
--
-- Returns No_Name if no such project was found
- function Get_Runtime_Path (Self : Project_Search_Path; Name : String)
- return String_Access;
+ function Get_Runtime_Path
+ (Self : Project_Search_Path;
+ Name : String) return String_Access;
-- Compute the full path for the project-based runtime name. It first
-- checks that name is not a simple name (must has a path separator in it),
-- and returns null in case of failure. This check might be removed in the
"Object_Dir cannot be empty",
Object_Dir.Location, Project);
- elsif Setup_Projects and then
- No_Sources and then
- Project.Extends = No_Project
+ elsif Setup_Projects
+ and then No_Sources
+ and then Project.Extends = No_Project
then
-- Do not create an object directory for a non extending project
-- with no sources.
"Exec_Dir cannot be empty",
Exec_Dir.Location, Project);
- elsif Setup_Projects and then
- No_Sources and then
- Project.Extends = No_Project
+ elsif Setup_Projects
+ and then No_Sources
+ and then Project.Extends = No_Project
then
-- Do not create an exec directory for a non extending project
-- with no sources.
-- Start of processing for Eval_Attribute
begin
- -- No folding in spec expression that comes from source where the prefix
- -- is an unfrozen entity. This avoids premature folding in cases like:
-
- -- procedure DefExprAnal is
- -- type R is new Integer;
- -- procedure P (Arg : Integer := R'Size);
- -- for R'Size use 64;
- -- procedure P (Arg : Integer := R'Size) is
- -- begin
- -- Put_Line (Arg'Img);
- -- end P;
- -- begin
- -- P;
- -- end;
-
- -- which should print 64 rather than 32. The exclusion of non-source
- -- constructs from this test comes from some internal usage in packed
- -- arrays, which otherwise fails, could use more analysis perhaps???
-
- -- We do however go ahead with generic actual types, otherwise we get
- -- some regressions, probably these types should be frozen anyway???
-
- if In_Spec_Expression
- and then Comes_From_Source (N)
- and then not (Is_Entity_Name (P)
- and then
- (Is_Frozen (Entity (P))
- or else (Is_Type (Entity (P))
- and then
- Is_Generic_Actual_Type (Entity (P)))))
- then
- return;
- end if;
-
-- Acquire first two expressions (at the moment, no attributes take more
-- than two expressions in any case).
-- aspect expressions have not been preanalyzed, so do it now.
-- There are no conformance checks to perform in this case.
- if No (T)
- and then Inside_A_Generic
- then
+ if No (T) and then Inside_A_Generic then
Check_Aspect_At_Freeze_Point (ASN);
return;
-
else
Preanalyze_Spec_Expression (End_Decl_Expr, T);
end if;
end if;
Debug_A_Entry ("resolving ", N);
+
if Debug_Flag_V then
Write_Overloads (N);
end if;
Resolution_Failed;
return;
+ -- Only one intepretation
+
else
-- In Ada 2005, if we have something like "X : T := 2 + 2;", where
-- the "+" on T is abstract, and the operands are of universal type,
-- the above code will have (incorrectly) resolved the "+" to the
- -- universal one in Standard. Therefore, we check for this case, and
- -- give an error. We can't do this earlier, because it would cause
- -- legal cases to get errors (when some other type has an abstract
- -- "+").
+ -- universal one in Standard. Therefore check for this case and give
+ -- an error. We can't do this earlier, because it would cause legal
+ -- cases to get errors (when some other type has an abstract "+").
if Ada_Version >= Ada_2005 and then
Nkind (N) in N_Op and then
OSDN Git Service
