[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:
parent
a3a16b2187
commit
47e11d08d6
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 --
|
||||
-----------------------------------
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue