diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index afb9062a868c..e644b7e78fd4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2011-12-12 Gary Dismukes + + * 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 + + * 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 + + * gsocket.h: Adjust previous patch. + 2011-12-12 Thomas Quinot * exp_disp.adb: Minor reformatting. diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb index ff2dc3729074..71f65dfea6b3 100644 --- a/gcc/ada/a-cobove.adb +++ b/gcc/ada/a-cobove.adb @@ -738,16 +738,16 @@ package body Ada.Containers.Bounded_Vectors is -- 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); diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index fed45faddda9..b845e6fc7ffb 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -1184,16 +1184,16 @@ package body Ada.Containers.Indefinite_Vectors is -- 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); @@ -2630,8 +2630,8 @@ package body Ada.Containers.Indefinite_Vectors is -- 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 @@ -2660,15 +2660,15 @@ package body Ada.Containers.Indefinite_Vectors is -- 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); diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index c16c2f66edc2..f80dd3b29c05 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -855,16 +855,16 @@ package body Ada.Containers.Vectors is -- 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); @@ -2199,8 +2199,8 @@ package body Ada.Containers.Vectors is -- 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 @@ -2229,15 +2229,15 @@ package body Ada.Containers.Vectors is -- 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); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 3e31e9a50bc1..336825ea91eb 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4360,13 +4360,23 @@ package body Freeze is -- 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; diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index ac00ec84d9e2..a1d0e8d36a94 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -1186,10 +1186,11 @@ procedure Gnatls is 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 @@ -1207,32 +1208,32 @@ procedure Gnatls is 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; ------------------- diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h index 713053d6235e..a4507fe8804c 100644 --- a/gcc/ada/gsocket.h +++ b/gcc/ada/gsocket.h @@ -165,13 +165,14 @@ #include #elif defined(VMS) +/* Allow a large number of fds for select. */ #define FD_SETSIZE 4096 -#include -#include #ifndef IN_RTS -/* These DEC C headers are not available when building with GCC */ -#include +/* These DEC C headers are not available when building with GCC. Order is + important. */ +#include #include +#include #include #include #endif diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 7cd1fe5fe8b4..bce59d96bcc0 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1405,23 +1405,33 @@ package body Prj.Env is -- 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); diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 0bdaafa58627..e2bb4448da5d 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -236,8 +236,9 @@ package Prj.Env is -- -- 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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index be644828594e..39a22b6c3168 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5284,9 +5284,9 @@ package body Prj.Nmsc is "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. @@ -5371,9 +5371,9 @@ package body Prj.Nmsc is "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. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d4c78b83521d..f72bebdba7b0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5618,40 +5618,6 @@ package body Sem_Attr is -- 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). diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1c607d97cd70..9ddabcc9cbb2 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5876,12 +5876,9 @@ package body Sem_Ch13 is -- 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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 64ac6526b0b5..663e0e8203a0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1989,6 +1989,7 @@ package body Sem_Res is end if; Debug_A_Entry ("resolving ", N); + if Debug_Flag_V then Write_Overloads (N); end if; @@ -2584,14 +2585,15 @@ package body Sem_Res is 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