OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* atree.ads: Minor comment fix.
	* a-stwifi.adb, a-stzfix.adb, a-strfix.adb, a-ztexio.ads, a-textio.ads,
	a-witeio.ads, sem_prag.adb: Minor reformatting.

2011-08-01  Doug Rupp  <rupp@adacore.com>

	* env.c (__gnat_setenv) [VMS]: Force 32bit on item list structure
	pointers. Use descrip.h header file for convenience. Add some
	comments.

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Entity): Call Check_Aspect_At_Freeze_Point
	(Freeze_All): Call Check_Aspect_At_End_Of_Declarations
	* sem_ch13.ads, sem_ch13.adb (Check_Aspect_At_Freeze_Point):
	New procedure.
	(Check_Aspect_At_End_Of_Declarations): New procedure
	(Analye_Aspect_Specification): Minor changes for above procedures
	* sinfo.ads, sinfo.adb (Is_Delayed_Aspect): Now set in aspect
	specification node as well.

2011-08-01  Pascal Obry  <obry@adacore.com>

	* adaint.c (_gnat_stat): GetFilesAttributesEx() would fail on special
	Windows files. Use GetFilesAttributes() in this case to check for file
	existence instead of returning with an error code.

From-SVN: r177008
This commit is contained in:
Arnaud Charlet 2011-08-01 12:27:49 +02:00
parent a3a16b2187
commit 47e11d08d6
16 changed files with 373 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

@ -1,3 +1,32 @@
2011-08-01 Robert Dewar <dewar@adacore.com>
* atree.ads: Minor comment fix.
* a-stwifi.adb, a-stzfix.adb, a-strfix.adb, a-ztexio.ads, a-textio.ads,
a-witeio.ads, sem_prag.adb: Minor reformatting.
2011-08-01 Doug Rupp <rupp@adacore.com>
* env.c (__gnat_setenv) [VMS]: Force 32bit on item list structure
pointers. Use descrip.h header file for convenience. Add some
comments.
2011-08-01 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Entity): Call Check_Aspect_At_Freeze_Point
(Freeze_All): Call Check_Aspect_At_End_Of_Declarations
* sem_ch13.ads, sem_ch13.adb (Check_Aspect_At_Freeze_Point):
New procedure.
(Check_Aspect_At_End_Of_Declarations): New procedure
(Analye_Aspect_Specification): Minor changes for above procedures
* sinfo.ads, sinfo.adb (Is_Delayed_Aspect): Now set in aspect
specification node as well.
2011-08-01 Pascal Obry <obry@adacore.com>
* adaint.c (_gnat_stat): GetFilesAttributesEx() would fail on special
Windows files. Use GetFilesAttributes() in this case to check for file
existence instead of returning with an error code.
2011-08-01 Vincent Celier <celier@adacore.com>
* a-stzfix.adb, a-stwifi.adb (Replace_Slice): Fixed computation when

11
gcc/ada/a-strfix.adb
View File

@ -485,8 +485,8 @@ package body Ada.Strings.Fixed is
Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
@ -496,13 +496,10 @@ package body Ada.Strings.Fixed is
Result : String (1 .. Result_Length);
begin
Result (1 .. Front_Len) :=
Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) :=
By;
Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) := By;
Result (Front_Len + By'Length + 1 .. Result'Length) :=
Source (High + 1 .. Source'Last);
return Result;
end;

17
gcc/ada/a-stwifi.adb
View File

@ -455,27 +455,24 @@ package body Ada.Strings.Wide_Fixed is
if High >= Low then
declare
Front_Len : constant Integer :=
Integer'Max (0, Low - Source'First);
Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
Front_Len + By'Length + Back_Len;
Front_Len + By'Length + Back_Len;
-- Length of result
Result : Wide_String (1 .. Result_Length);
Result : Wide_String (1 .. Result_Length);
begin
Result (1 .. Front_Len) :=
Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) :=
By;
Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) := By;
Result (Front_Len + By'Length + 1 .. Result'Length) :=
Source (High + 1 .. Source'Last);
return Result;
end;

11
gcc/ada/a-stzfix.adb
View File

@ -460,8 +460,8 @@ package body Ada.Strings.Wide_Wide_Fixed is
Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
Back_Len : constant Integer :=
Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
@ -471,13 +471,10 @@ package body Ada.Strings.Wide_Wide_Fixed is
Result : Wide_Wide_String (1 .. Result_Length);
begin
Result (1 .. Front_Len) :=
Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) :=
By;
Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
Result (Front_Len + 1 .. Front_Len + By'Length) := By;
Result (Front_Len + By'Length + 1 .. Result'Length) :=
Source (High + 1 .. Source'Last);
return Result;
end;

6
gcc/ada/a-textio.ads
View File

@ -71,9 +71,9 @@ package Ada.Text_IO is
-- Line and page length
subtype Field is Integer range 0 .. 255;
-- Note: if for any reason, there is a need to increase this value,
-- then it will be necessary to change the corresponding value in
-- System.Img_Real in file s-imgrea.adb.
-- Note: if for any reason, there is a need to increase this value, then it
-- will be necessary to change the corresponding value in System.Img_Real
-- in file s-imgrea.adb.
subtype Number_Base is Integer range 2 .. 16;

6
gcc/ada/a-witeio.ads
View File

@ -73,9 +73,9 @@ package Ada.Wide_Text_IO is
-- Line and page length
subtype Field is Integer range 0 .. 255;
-- Note: if for any reason, there is a need to increase this value,
-- then it will be necessary to change the corresponding value in
-- System.Img_Real in file s-imgrea.adb.
-- Note: if for any reason, there is a need to increase this value, then it
-- will be necessary to change the corresponding value in System.Img_Real
-- in file s-imgrea.adb.
subtype Number_Base is Integer range 2 .. 16;

6
gcc/ada/a-ztexio.ads
View File

@ -73,9 +73,9 @@ package Ada.Wide_Wide_Text_IO is
-- Line and page length
subtype Field is Integer range 0 .. 255;
-- Note: if for any reason, there is a need to increase this value,
-- then it will be necessary to change the corresponding value in
-- System.Img_Real in file s-imgrea.adb.
-- Note: if for any reason, there is a need to increase this value, then it
-- will be necessary to change the corresponding value in System.Img_Real
-- in file s-imgrea.adb.
subtype Number_Base is Integer range 2 .. 16;

17
gcc/ada/adaint.c
View File

@ -1697,6 +1697,7 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
int name_len;
BOOL res;
DWORD error;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
name_len = _tcslen (wname);
@ -1708,8 +1709,19 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
if (res == FALSE)
switch (GetLastError()) {
if (res == FALSE) {
error = GetLastError();
/* Check file existence using GetFileAttributes() which does not fail on
special Windows files like con:, aux:, nul: etc... */
if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
/* Just pretend that it is a regular and readable file */
statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
return 0;
}
switch (error) {
case ERROR_ACCESS_DENIED:
case ERROR_SHARING_VIOLATION:
case ERROR_LOCK_VIOLATION:
@ -1722,6 +1734,7 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
default:
return ENOENT;
}
}
f2t (&fad.ftCreationTime, &statbuf->st_ctime);
f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);

20
gcc/ada/atree.ads
View File

@ -404,16 +404,16 @@ package Atree is
-- with copying aspect specifications where this is required.
function New_Copy (Source : Node_Id) return Node_Id;
-- This function allocates a completely new node, and then initializes
-- it by copying the contents of the source node into it. The contents
-- of the source node is not affected. The target node is always marked
-- as not being in a list (even if the source is a list member). The
-- new node will have an extension if the source has an extension.
-- New_Copy (Empty) returns Empty and New_Copy (Error) returns Error.
-- Note that, unlike New_Copy_Tree, New_Copy does not recursively copy any
-- descendents, so in general parent pointers are not set correctly for
-- the descendents of the copied node. Both normal and extended nodes
-- (entities) may be copied using New_Copy.
-- This function allocates a completely new node, and then initializes it
-- by copying the contents of the source node into it. The contents of the
-- source node is not affected. The target node is always marked as not
-- being in a list (even if the source is a list member). The new node will
-- have an extension if the source has an extension. New_Copy (Empty)
-- returns Empty and New_Copy (Error) returns Error. Note that, unlike
-- Copy_Separate_Tree, New_Copy does not recursively copy any descendents,
-- so in general parent pointers are not set correctly for the descendents
-- of the copied node. Both normal and extended nodes (entities) may be
-- copied using New_Copy.
function Relocate_Node (Source : Node_Id) return Node_Id;
-- Source is a non-entity node that is to be relocated. A new node is

21
gcc/ada/env.c
View File

@ -50,6 +50,7 @@ extern "C" {
#include <time.h>
#ifdef VMS
#include <unixio.h>
#include <vms/descrip.h>
#endif
#if defined (__MINGW32__)
@ -93,17 +94,11 @@ __gnat_getenv (char *name, int *len, char **value)
static char *to_host_path_spec (char *);
struct descriptor_s
{
unsigned short len, mbz;
__char_ptr32 adr;
};
typedef struct _ile3
{
unsigned short len, code;
__char_ptr32 adr;
unsigned short *retlen_adr;
__char_ptr32 retlen_adr;
} ile_s;
#endif
@ -112,18 +107,19 @@ void
__gnat_setenv (char *name, char *value)
{
#if defined (VMS)
struct descriptor_s name_desc;
struct dsc$descriptor_s name_desc;
/* Put in JOB table for now, so that the project stuff at least works. */
struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
$DESCRIPTOR (table_desc, "LNM$JOB");
char *host_pathspec = value;
char *copy_pathspec;
int num_dirs_in_pathspec = 1;
char *ptr;
long status;
name_desc.len = strlen (name);
name_desc.mbz = 0;
name_desc.adr = name;
name_desc.dsc$w_length = strlen (name);
name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
name_desc.dsc$b_class = DSC$K_CLASS_S;
name_desc.dsc$a_pointer = name; /* ??? Danger, not 64bit safe. */
if (*host_pathspec == 0)
/* deassign */
@ -141,6 +137,7 @@ __gnat_setenv (char *name, char *value)
{
int i, status;
/* Alloca is guaranteed to be 32bit. */
ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
char *curr, *next;

27
gcc/ada/freeze.adb
View File

@ -1323,6 +1323,27 @@ package body Freeze is
if not Is_Frozen (E) then
Flist := Freeze_Entity (E, After);
Process_Flist;
-- If already frozen, and there are delayed aspects, this is where
-- we do the visibility check for these aspects (see Sem_Ch13 spec
-- for a description of how we handle aspect visibility).
elsif Has_Delayed_Aspects (E) then
declare
Ritem : Node_Id;
begin
Ritem := First_Rep_Item (E);
while Present (Ritem) loop
if Nkind (Ritem) = N_Aspect_Specification
and then Is_Delayed_Aspect (Ritem)
then
Check_Aspect_At_End_Of_Declarations (Ritem);
end if;
Ritem := Next_Rep_Item (Ritem);
end loop;
end;
end if;
-- If an incomplete type is still not frozen, this may be a
@ -2390,9 +2411,9 @@ package body Freeze is
while Present (Ritem) loop
if Nkind (Ritem) = N_Aspect_Specification
and then Entity (Ritem) = E
and then Is_Delayed_Aspect (Ritem)
then
Aitem := Aspect_Rep_Item (Ritem);
pragma Assert (Is_Delayed_Aspect (Aitem));
Set_Parent (Aitem, Ritem);
-- Deal with Boolean case, if no expression, True, otherwise
@ -2423,6 +2444,10 @@ package body Freeze is
-- Analyze the pragma after possibly setting Aspect_Cancel
Analyze (Aitem);
-- Do visibility analysis for aspect at freeze point
Check_Aspect_At_Freeze_Point (Ritem);
end if;
Next_Rep_Item (Ritem);

174
gcc/ada/sem_ch13.adb
View File

@ -700,11 +700,10 @@ package body Sem_Ch13 is
-- one of two things happens:
-- If we are required to delay the evaluation of this aspect to the
-- freeze point, we preanalyze the relevant argument, and then attach
-- the corresponding pragma/attribute definition clause to the aspect
-- specification node, which is then placed in the Rep Item chain.
-- In this case we mark the entity with the Has_Delayed_Aspects flag,
-- and we evaluate the rep item at the freeze point.
-- freeze point, we attach the corresponding pragma/attribute definition
-- clause to the aspect specification node, which is then placed in the
-- Rep Item chain. In this case we mark the entity by setting the flag
-- Has_Delayed_Aspects and we evaluate the rep item at the freeze point.
-- If no delay is required, we just insert the pragma or attribute
-- after the declaration, and it will get processed by the normal
@ -800,6 +799,11 @@ package body Sem_Ch13 is
Next (Anod);
end loop;
-- Copy expression for later processing by the procedures
-- Check_Aspect_At_[Freeze_Point | End_Of_Declarations]
Set_Entity (Id, New_Copy_Tree (Expr));
-- Processing based on specific aspect
case A_Id is
@ -836,6 +840,7 @@ package body Sem_Ch13 is
else
Delay_Required := True;
Set_Is_Delayed_Aspect (Aspect);
end if;
-- Aspects corresponding to attribute definition clauses
@ -868,6 +873,7 @@ package body Sem_Ch13 is
-- Here a delay is required
Delay_Required := True;
Set_Is_Delayed_Aspect (Aspect);
-- Aspects corresponding to pragmas with two arguments, where
-- the first argument is a local name referring to the entity,
@ -981,6 +987,7 @@ package body Sem_Ch13 is
end if;
Set_From_Aspect_Specification (Aitem, True);
Set_Is_Delayed_Aspect (Aspect);
-- For Pre/Post cases, insert immediately after the entity
-- declaration, since that is the required pragma placement.
@ -1032,6 +1039,7 @@ package body Sem_Ch13 is
end if;
Set_From_Aspect_Specification (Aitem, True);
Set_Is_Delayed_Aspect (Aspect);
-- For Invariant case, insert immediately after the entity
-- declaration. We do not have to worry about delay issues
@ -1065,6 +1073,7 @@ package body Sem_Ch13 is
-- have a place to build the predicate function).
Ensure_Freeze_Node (E);
Set_Is_Delayed_Aspect (Aspect);
-- For Predicate case, insert immediately after the entity
-- declaration. We do not have to worry about delay issues
@ -4850,6 +4859,161 @@ package body Sem_Ch13 is
return;
end Build_Static_Predicate;
-----------------------------------------
-- Check_Aspect_At_End_Of_Declarations --
-----------------------------------------
procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id) is
Ent : constant Entity_Id := Entity (ASN);
Ident : constant Node_Id := Identifier (ASN);
Freeze_Expr : constant Node_Id := Expression (ASN);
-- Preanalyzed expression from call to Check_Aspect_At_Freeze_Point
End_Decl_Expr : constant Node_Id := Entity (Ident);
-- Expression to be analyzed at end of declarations
T : constant Entity_Id := Etype (Freeze_Expr);
-- Type required for preanalyze call
A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
Err : Boolean;
-- Set False if error
-- On entry to this procedure, Entity (Ident) contains a copy of the
-- original expression from the aspect, saved for this purpose, and
-- but Expression (Ident) is a preanalyzed copy of the expression,
-- preanalyzed just after the freeze point.
begin
-- Case of stream attributes, just have to compare entities
if A_Id = Aspect_Input or else
A_Id = Aspect_Output or else
A_Id = Aspect_Read or else
A_Id = Aspect_Write
then
Analyze (End_Decl_Expr);
Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
-- All other cases
else
Preanalyze_Spec_Expression (End_Decl_Expr, T);
Err := not Fully_Conformant_Expressions (End_Decl_Expr, Freeze_Expr);
end if;
-- Output error message if error
if Err then
Error_Msg_NE
("visibility of aspect for& changes after freeze point",
ASN, Ent);
Error_Msg_NE
("?info: & is frozen here, aspects evaluated at this point",
Freeze_Node (Ent), Ent);
end if;
end Check_Aspect_At_End_Of_Declarations;
----------------------------------
-- Check_Aspect_At_Freeze_Point --
----------------------------------
procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id) is
Ident : constant Node_Id := Identifier (ASN);
-- Identifier (use Entity field to save expression)
T : Entity_Id;
-- Type required for preanalyze call
A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
begin
-- On entry to this procedure, Entity (Ident) contains a copy of the
-- original expression from the aspect, saved for this purpose.
-- On exit from this procedure Entity (Ident) is unchanged, still
-- containing that copy, but Expression (Ident) is a preanalyzed copy
-- of the expression, preanalyzed just after the freeze point.
-- Make a copy of the expression to be preanalyed
Set_Expression (ASN, New_Copy_Tree (Entity (Ident)));
-- Find type for preanalyze call
case A_Id is
-- No_Aspect should be impossible
when No_Aspect =>
raise Program_Error;
-- Aspects taking an optional boolean argument. Note that we will
-- never be called with an empty expression, because such aspects
-- never need to be delayed anyway.
when Boolean_Aspects =>
pragma Assert (Present (Expression (ASN)));
T := Standard_Boolean;
-- Aspects corresponding to attribute definition clauses
when Aspect_Address =>
T := RTE (RE_Address);
when Aspect_Bit_Order =>
T := RTE (RE_Bit_Order);
when Aspect_External_Tag =>
T := Standard_String;
when Aspect_Storage_Pool =>
T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
when
Aspect_Alignment |
Aspect_Component_Size |
Aspect_Machine_Radix |
Aspect_Object_Size |
Aspect_Size |
Aspect_Storage_Size |
Aspect_Stream_Size |
Aspect_Value_Size =>
T := Any_Integer;
-- Stream attribute. Special case, the expression is just an entity
-- that does not need any resolution, so just analyze.
when Aspect_Input |
Aspect_Output |
Aspect_Read |
Aspect_Write =>
Analyze (Expression (ASN));
return;
-- Suppress/Unsupress/Warnings should never be delayed
when Aspect_Suppress |
Aspect_Unsuppress |
Aspect_Warnings =>
raise Program_Error;
-- Pre/Post/Invariant/Predicate take boolean expressions
when Aspect_Pre |
Aspect_Post |
Aspect_Invariant |
Aspect_Predicate =>
T := Standard_Boolean;
end case;
-- Do the preanalyze call
Preanalyze_Spec_Expression (Expression (ASN), T);
end Check_Aspect_At_Freeze_Point;
-----------------------------------
-- Check_Constant_Address_Clause --
-----------------------------------

77
gcc/ada/sem_ch13.ads
View File

@ -236,4 +236,81 @@ package Sem_Ch13 is
Table_Increment => 200,
Table_Name => "Independence_Checks");
-----------------------------------
-- Handling of Aspect Visibility --
-----------------------------------
-- The visibility of aspects is tricky. First, the visibility is delayed
-- to the freeze point. This is not too complicated, what we do is simply
-- to leave the aspect "laying in wait" for the freeze point, and at that
-- point materialize and analye the corresponding attribute definition
-- clause or pragma. There is some special processing for preconditions
-- and postonditions, where the pragmas themselves deal with the required
-- delay, but basically the approach is the same, delay analysis of the
-- expression to the freeze point.
-- Much harder is the requirement for diagnosing cases in which an early
-- freeze causes a change in visibility. Consider:
-- package AspectVis is
-- R_Size : constant Integer := 32;
--
-- package Inner is
-- type R is new Integer with
-- Size => R_Size;
-- F : R; -- freezes
-- R_Size : constant Integer := 64;
-- S : constant Integer := R'Size; -- 32 not 64
-- end Inner;
-- end AspectVis;
-- Here the 32 not 64 shows what would be expected if this program were
-- legal, since the evaluation of R_Size has to be done at the freeze
-- point and gets the outer definition not the inner one.
-- But the language rule requires this program to be diagnosed as illegal
-- because the visibility changes between the freeze point and the end of
-- the declarative region.
-- To meet this requirement, we first note that the Expression field of the
-- N_Aspect_Specification node holds the raw unanalyzed expression, which
-- will get used in processing the aspect. At the time of analyzing the
-- N_Aspect_Specification node, we create a complete copy of the expression
-- and store it in the entity field of the Identifier (an odd usage, but
-- the identifier is not used except to identify the aspect, so its Entity
-- field is otherwise unused, and we are short of room in the node).
-- This copy stays unanalyzed up to the freeze point, where we analyze the
-- resulting pragma or attribute definition clause, except that in the
-- case of invariants and predicates, we mark occurrences of the subtype
-- name as having the entity of the subprogram parameter, so that they
-- will not cause trouble in the following steps.
-- Then at the freeze point, we create another copy of this unanalyzed
-- expression. By this time we no longer need the Expression field for
-- other purposes, so we can store it there. Now we have two copies of
-- the original unanalyzed expression. One of them gets preanalyzed at
-- the freeze point to capture the visibility at the freeze point.
-- Now when we hit the freeze all at the end of the declarative part, if
-- we come across a frozen entity with delayed aspects, we still have one
-- copy of the unanalyzed expression available in the node, and we again
-- do a preanalysis using that copy and the visibility at the end of the
-- declarative part. Now we have two preanalyzed expression (preanalysis
-- is good enough, since we are only interested in referenced entities).
-- One captures the visibility at the freeze point, the other captures the
-- visibility at the end of the declarative part. We see if the entities
-- in these two expressions are the same, by seeing if the two expressions
-- are fully conformant, and if not, issue appropriate error messages.
-- Quite an awkward procedure, but this is an awkard requirement!
procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id);
-- Performs the processing described above at the freeze point, ASN is the
-- N_Aspect_Specification node for the aspect.
procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id);
-- Performs the processing described above at the freeze all point, and
-- issues appropriate error messages if the visibility has indeed changed.
-- Again, ASN is the N_Aspect_Specification node for the aspect.
end Sem_Ch13;

4
gcc/ada/sem_prag.adb
View File

@ -11243,8 +11243,8 @@ package body Sem_Prag is
---------------
-- pragma Predicate
-- ([Entity =>] type_LOCAL_NAME,
-- [Check =>] EXPRESSION);
-- ([Entity =>] type_LOCAL_NAME,
-- [Check =>] EXPRESSION);
when Pragma_Predicate => Predicate : declare
Type_Id : Node_Id;

2
gcc/ada/sinfo.adb
View File

@ -1732,6 +1732,7 @@ package body Sinfo is
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aspect_Specification
or else NT (N).Nkind = N_Attribute_Definition_Clause
or else NT (N).Nkind = N_Pragma);
return Flag14 (N);
@ -4760,6 +4761,7 @@ package body Sinfo is
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Aspect_Specification
or else NT (N).Nkind = N_Attribute_Definition_Clause
or else NT (N).Nkind = N_Pragma);
Set_Flag14 (N, Val);

11
gcc/ada/sinfo.ads
View File

@ -1265,7 +1265,8 @@ package Sinfo is
-- Is_Delayed_Aspect (Flag14-Sem)
-- Present in N_Pragma and N_Attribute_Definition_Clause nodes which
-- come from aspect specifications, where the evaluation of the aspect
-- must be delayed to the freeze point.
-- must be delayed to the freeze point. This flag is also set True in
-- the corresponding N_Aspect_Specification node.
-- Is_Controlling_Actual (Flag16-Sem)
-- This flag is set on in an expression that is a controlling argument in
@ -6548,9 +6549,17 @@ package Sinfo is
-- Next_Rep_Item (Node5-Sem)
-- Split_PPC (Flag17) Set if split pre/post attribute
-- Is_Boolean_Aspect (Flag16-Sem)
-- Is_Delayed_Aspect (Flag14-Sem)
-- Note: Aspect_Specification is an Ada 2012 feature
-- Note: The Identifier serves to identify the aspect involved (it
-- is the aspect whose name corresponds to the Chars field). This
-- means that the other fields of this identifier are unused, and
-- in particular we use the Entity field of this identifier to save
-- a copy of the expression for visibility analysis, see spec of
-- Sem_Ch13 for full details of this usage.
-- Note: When a Pre or Post aspect specification is processed, it is
-- broken into AND THEN sections. The left most section has Split_PPC
-- set to False, indicating that it is the original specification (e.g.