git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r182228
This commit is contained in:
Arnaud Charlet 2011-12-12 12:52:04 +01:00
parent ee1a757231
commit fe58fea70b
13 changed files with 112 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
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> 2011-12-12 Thomas Quinot <quinot@adacore.com>
* exp_disp.adb: Minor reformatting. * exp_disp.adb: Minor reformatting.

12
gcc/ada/a-cobove.adb
View File

@ -738,16 +738,16 @@ package body Ada.Containers.Bounded_Vectors is
-- The value of the iterator object's Index component influences the -- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function. -- behavior of the First (and Last) selector function.
-- When the Index component is No_Index, this means the iterator object -- When the Index component is No_Index, this means the iterator
-- was constructed without a start expression, in which case the -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire -- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward -- sequence of items (corresponding to Container.First, for a forward
-- iterator). -- iterator).
-- Otherwise, this is iteration over a partial sequence of items. When -- Otherwise, this is iteration over a partial sequence of items.
-- the Index component isn't No_Index, the iterator object was -- When the Index component isn't No_Index, the iterator object was
-- constructed with a start expression, that specifies the position from -- constructed with a start expression, that specifies the position
-- which the (forward) partial iteration begins. -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then if Object.Index = No_Index then
return First (Object.Container.all); return First (Object.Container.all);

28
gcc/ada/a-coinve.adb
View File

@ -1184,16 +1184,16 @@ package body Ada.Containers.Indefinite_Vectors is
-- The value of the iterator object's Index component influences the -- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function. -- behavior of the First (and Last) selector function.
-- When the Index component is No_Index, this means the iterator object -- When the Index component is No_Index, this means the iterator
-- was constructed without a start expression, in which case the -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire -- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward -- sequence of items (corresponding to Container.First, for a forward
-- iterator). -- iterator).
-- Otherwise, this is iteration over a partial sequence of items. When -- Otherwise, this is iteration over a partial sequence of items.
-- the Index component isn't No_Index, the iterator object was -- When the Index component isn't No_Index, the iterator object was
-- constructed with a start expression, that specifies the position from -- constructed with a start expression, that specifies the position
-- which the (forward) partial iteration begins. -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then if Object.Index = No_Index then
return First (Object.Container.all); return First (Object.Container.all);
@ -2630,8 +2630,8 @@ package body Ada.Containers.Indefinite_Vectors is
-- is a partial iteration, over a subset of the complete sequence of -- is a partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression, -- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that -- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is -- the start position has the same value irrespective of whether this
-- a forward or reverse iteration. -- is a forward or reverse iteration.
return It : constant Iterator := return It : constant Iterator :=
(Limited_Controlled with (Limited_Controlled with
@ -2660,15 +2660,15 @@ package body Ada.Containers.Indefinite_Vectors is
-- The value of the iterator object's Index component influences the -- The value of the iterator object's Index component influences the
-- behavior of the Last (and First) selector function. -- behavior of the Last (and First) selector function.
-- When the Index component is No_Index, this means the iterator object -- When the Index component is No_Index, this means the iterator
-- was constructed without a start expression, in which case the -- object was constructed without a start expression, in which case the
-- (reverse) iteration starts from the (logical) beginning of the entire -- (reverse) iteration starts from the (logical) beginning of the entire
-- sequence (corresponding to Container.Last, for a reverse iterator). -- sequence (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When -- Otherwise, this is iteration over a partial sequence of items.
-- the Index component is not No_Index, the iterator object was -- When the Index component is not No_Index, the iterator object was
-- constructed with a start expression, that specifies the position from -- constructed with a start expression, that specifies the position
-- which the (reverse) partial iteration begins. -- from which the (reverse) partial iteration begins.
if Object.Index = No_Index then if Object.Index = No_Index then
return Last (Object.Container.all); return Last (Object.Container.all);

28
gcc/ada/a-convec.adb
View File

@ -855,16 +855,16 @@ package body Ada.Containers.Vectors is
-- The value of the iterator object's Index component influences the -- The value of the iterator object's Index component influences the
-- behavior of the First (and Last) selector function. -- behavior of the First (and Last) selector function.
-- When the Index component is No_Index, this means the iterator object -- When the Index component is No_Index, this means the iterator
-- was constructed without a start expression, in which case the -- object was constructed without a start expression, in which case the
-- (forward) iteration starts from the (logical) beginning of the entire -- (forward) iteration starts from the (logical) beginning of the entire
-- sequence of items (corresponding to Container.First, for a forward -- sequence of items (corresponding to Container.First, for a forward
-- iterator). -- iterator).
-- Otherwise, this is iteration over a partial sequence of items. When -- Otherwise, this is iteration over a partial sequence of items.
-- the Index component isn't No_Index, the iterator object was -- When the Index component isn't No_Index, the iterator object was
-- constructed with a start expression, that specifies the position from -- constructed with a start expression, that specifies the position
-- which the (forward) partial iteration begins. -- from which the (forward) partial iteration begins.
if Object.Index = No_Index then if Object.Index = No_Index then
return First (Object.Container.all); return First (Object.Container.all);
@ -2199,8 +2199,8 @@ package body Ada.Containers.Vectors is
-- is a partial iteration, over a subset of the complete sequence of -- is a partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression, -- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that -- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is -- the start position has the same value irrespective of whether this
-- a forward or reverse iteration. -- is a forward or reverse iteration.
return It : constant Iterator := return It : constant Iterator :=
(Limited_Controlled with (Limited_Controlled with
@ -2229,15 +2229,15 @@ package body Ada.Containers.Vectors is
-- The value of the iterator object's Index component influences the -- The value of the iterator object's Index component influences the
-- behavior of the Last (and First) selector function. -- behavior of the Last (and First) selector function.
-- When the Index component is No_Index, this means the iterator object -- When the Index component is No_Index, this means the iterator
-- was constructed without a start expression, in which case the -- object was constructed without a start expression, in which case the
-- (reverse) iteration starts from the (logical) beginning of the entire -- (reverse) iteration starts from the (logical) beginning of the entire
-- sequence (corresponding to Container.Last, for a reverse iterator). -- sequence (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When -- Otherwise, this is iteration over a partial sequence of items.
-- the Index component is not No_Index, the iterator object was -- When the Index component is not No_Index, the iterator object was
-- constructed with a start expression, that specifies the position from -- constructed with a start expression, that specifies the position
-- which the (reverse) partial iteration begins. -- from which the (reverse) partial iteration begins.
if Object.Index = No_Index then if Object.Index = No_Index then
return Last (Object.Container.all); return Last (Object.Container.all);

16
gcc/ada/freeze.adb
View File

@ -4360,13 +4360,23 @@ package body Freeze is
-- If expression is non-static, then it does not freeze in a default -- If expression is non-static, then it does not freeze in a default
-- expression, see section "Handling of Default Expressions" in the -- expression, see section "Handling of Default Expressions" in the
-- spec of package Sem for further details. Note that we have to -- spec of package Sem for further details. Note that we have to make
-- make sure that we actually have a real expression (if we have -- sure that we actually have a real expression (if we have a subtype
-- a subtype indication, we can't test Is_Static_Expression!) -- 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 if In_Spec_Exp
and then Nkind (N) in N_Subexpr and then Nkind (N) in N_Subexpr
and then not Is_Static_Expression (N) 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 then
return; return;
end if; end if;

17
gcc/ada/gnatls.adb
View File

@ -1186,10 +1186,11 @@ procedure Gnatls is
procedure Search_RTS (Name : String) is procedure Search_RTS (Name : String) is
Src_Path : String_Ptr; Src_Path : String_Ptr;
Lib_Path : String_Ptr; Lib_Path : String_Ptr;
-- Pathes for source and include subdirs -- Paths for source and include subdirs
Rts_Full_Path : String_Access; Rts_Full_Path : String_Access;
-- Full path for RTS project -- Full path for RTS project
begin begin
-- Try to find the RTS -- Try to find the RTS
@ -1207,32 +1208,32 @@ procedure Gnatls is
if Lib_Path /= null then if Lib_Path /= null then
Osint.Fail ("RTS path not valid: missing adainclude directory"); Osint.Fail ("RTS path not valid: missing adainclude directory");
elsif Src_Path /= null then elsif Src_Path /= null then
Osint.Fail ("RTS path not valid: missing adalib directory"); Osint.Fail ("RTS path not valid: missing adalib directory");
end if; end if;
-- Try to find the RTS on the project path. First setup the project -- Try to find the RTS on the project path. First setup the project path
-- path.
Initialize_Default_Project_Path Initialize_Default_Project_Path
(Prj_Path, Target_Name => Sdefault.Target_Name.all); (Prj_Path, Target_Name => Sdefault.Target_Name.all);
Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name); Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
if Rts_Full_Path /= null then if Rts_Full_Path /= null then
-- Directory name was found on the project path. Look for the -- Directory name was found on the project path. Look for the
-- include subdir(s). -- 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 if Src_Path /= null then
Add_Search_Dirs (Src_Path, Include); Add_Search_Dirs (Src_Path, Include);
return; return;
end if; end if;
end if; end if;
Osint.Fail ("RTS path not valid: missing " & Osint.Fail
"adainclude and adalib directories"); ("RTS path not valid: missing adainclude and adalib directories");
end Search_RTS; end Search_RTS;
------------------- -------------------

9
gcc/ada/gsocket.h
View File

@ -165,13 +165,14 @@
#include <windows.h> #include <windows.h>
#elif defined(VMS) #elif defined(VMS)
/* Allow a large number of fds for select. */
#define FD_SETSIZE 4096 #define FD_SETSIZE 4096
#include <sys/types.h>
#include <sys/time.h>
#ifndef IN_RTS #ifndef IN_RTS
/* These DEC C headers are not available when building with GCC */ /* These DEC C headers are not available when building with GCC. Order is
#include <in.h> important. */
#include <time.h>
#include <tcp.h> #include <tcp.h>
#include <in.h>
#include <ioctl.h> #include <ioctl.h>
#include <netdb.h> #include <netdb.h>
#endif #endif

18
gcc/ada/prj-env.adb
View File

@ -1405,23 +1405,33 @@ package body Prj.Env is
-- Get_Runtime_Path -- -- Get_Runtime_Path --
---------------------- ----------------------
function Get_Runtime_Path (Self : Project_Search_Path; Name : String) function Get_Runtime_Path
return String_Access is (Self : Project_Search_Path;
Name : String) return String_Access
is
function Is_Base_Name (Path : String) return Boolean; function Is_Base_Name (Path : String) return Boolean;
-- Returns True if Path has no directory separator -- Returns True if Path has no directory separator
------------------
-- Is_Base_Name --
------------------
function Is_Base_Name (Path : String) return Boolean is function Is_Base_Name (Path : String) return Boolean is
begin begin
for I in Path'Range loop for J in Path'Range loop
if Path (I) = Directory_Separator or else Path (I) = '/' then if Path (J) = Directory_Separator or else Path (J) = '/' then
return False; return False;
end if; end if;
end loop; end loop;
return True; return True;
end Is_Base_Name; end Is_Base_Name;
function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
(Check_Filename => Is_Directory); (Check_Filename => Is_Directory);
-- Start of processing for Get_Runtime_Path
begin begin
if not Is_Base_Name (Name) then if not Is_Base_Name (Name) then
return Find_Rts_In_Path (Self, Name); return Find_Rts_In_Path (Self, Name);

5
gcc/ada/prj-env.ads
View File

@ -236,8 +236,9 @@ package Prj.Env is
-- --
-- Returns No_Name if no such project was found -- Returns No_Name if no such project was found
function Get_Runtime_Path (Self : Project_Search_Path; Name : String) function Get_Runtime_Path
return String_Access; (Self : Project_Search_Path;
Name : String) return String_Access;
-- Compute the full path for the project-based runtime name. It first -- 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), -- 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 -- and returns null in case of failure. This check might be removed in the

12
gcc/ada/prj-nmsc.adb
View File

@ -5284,9 +5284,9 @@ package body Prj.Nmsc is
"Object_Dir cannot be empty", "Object_Dir cannot be empty",
Object_Dir.Location, Project); Object_Dir.Location, Project);
elsif Setup_Projects and then elsif Setup_Projects
No_Sources and then and then No_Sources
Project.Extends = No_Project and then Project.Extends = No_Project
then then
-- Do not create an object directory for a non extending project -- Do not create an object directory for a non extending project
-- with no sources. -- with no sources.
@ -5371,9 +5371,9 @@ package body Prj.Nmsc is
"Exec_Dir cannot be empty", "Exec_Dir cannot be empty",
Exec_Dir.Location, Project); Exec_Dir.Location, Project);
elsif Setup_Projects and then elsif Setup_Projects
No_Sources and then and then No_Sources
Project.Extends = No_Project and then Project.Extends = No_Project
then then
-- Do not create an exec directory for a non extending project -- Do not create an exec directory for a non extending project
-- with no sources. -- with no sources.

34
gcc/ada/sem_attr.adb
View File

@ -5618,40 +5618,6 @@ package body Sem_Attr is
-- Start of processing for Eval_Attribute -- Start of processing for Eval_Attribute
begin 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 -- Acquire first two expressions (at the moment, no attributes take more
-- than two expressions in any case). -- than two expressions in any case).

5
gcc/ada/sem_ch13.adb
View File

@ -5876,12 +5876,9 @@ package body Sem_Ch13 is
-- aspect expressions have not been preanalyzed, so do it now. -- aspect expressions have not been preanalyzed, so do it now.
-- There are no conformance checks to perform in this case. -- There are no conformance checks to perform in this case.
if No (T) if No (T) and then Inside_A_Generic then
and then Inside_A_Generic
then
Check_Aspect_At_Freeze_Point (ASN); Check_Aspect_At_Freeze_Point (ASN);
return; return;
else else
Preanalyze_Spec_Expression (End_Decl_Expr, T); Preanalyze_Spec_Expression (End_Decl_Expr, T);
end if; end if;

10
gcc/ada/sem_res.adb
View File

@ -1989,6 +1989,7 @@ package body Sem_Res is
end if; end if;
Debug_A_Entry ("resolving ", N); Debug_A_Entry ("resolving ", N);
if Debug_Flag_V then if Debug_Flag_V then
Write_Overloads (N); Write_Overloads (N);
end if; end if;
@ -2584,14 +2585,15 @@ package body Sem_Res is
Resolution_Failed; Resolution_Failed;
return; return;
-- Only one intepretation
else else
-- In Ada 2005, if we have something like "X : T := 2 + 2;", where -- 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 "+" on T is abstract, and the operands are of universal type,
-- the above code will have (incorrectly) resolved the "+" to the -- the above code will have (incorrectly) resolved the "+" to the
-- universal one in Standard. Therefore, we check for this case, and -- universal one in Standard. Therefore check for this case and give
-- give an error. We can't do this earlier, because it would cause -- an error. We can't do this earlier, because it would cause legal
-- legal cases to get errors (when some other type has an abstract -- cases to get errors (when some other type has an abstract "+").
-- "+").
if Ada_Version >= Ada_2005 and then if Ada_Version >= Ada_2005 and then
Nkind (N) in N_Op and then Nkind (N) in N_Op and then