diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 29 | ||||
| -rw-r--r-- | gcc/ada/a-strfix.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/a-stwifi.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/a-stzfix.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/a-textio.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-witeio.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-ztexio.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 17 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/env.c | 21 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 174 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.ads | 77 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 11 |
16 files changed, 373 insertions, 66 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e9de3368258..270f4193c82 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/a-strfix.adb b/gcc/ada/a-strfix.adb index 6bb0229c71e..0f3395899b3 100644 --- a/gcc/ada/a-strfix.adb +++ b/gcc/ada/a-strfix.adb @@ -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; diff --git a/gcc/ada/a-stwifi.adb b/gcc/ada/a-stwifi.adb index 31278505b8a..afb443de399 100644 --- a/gcc/ada/a-stwifi.adb +++ b/gcc/ada/a-stwifi.adb @@ -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; diff --git a/gcc/ada/a-stzfix.adb b/gcc/ada/a-stzfix.adb index 67f5482f95b..67c2fe56cec 100644 --- a/gcc/ada/a-stzfix.adb +++ b/gcc/ada/a-stzfix.adb @@ -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; diff --git a/gcc/ada/a-textio.ads b/gcc/ada/a-textio.ads index 1999b7cc1ab..3794cb9c015 100644 --- a/gcc/ada/a-textio.ads +++ b/gcc/ada/a-textio.ads @@ -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; diff --git a/gcc/ada/a-witeio.ads b/gcc/ada/a-witeio.ads index d9c088f23e1..463207b7ce3 100644 --- a/gcc/ada/a-witeio.ads +++ b/gcc/ada/a-witeio.ads @@ -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; diff --git a/gcc/ada/a-ztexio.ads b/gcc/ada/a-ztexio.ads index b03af58c48b..c95b3c4a2ef 100644 --- a/gcc/ada/a-ztexio.ads +++ b/gcc/ada/a-ztexio.ads @@ -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; diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index dbd76a5e0c7..c1e97c64b40 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -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); diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index cf8573f0b5c..386dcefa820 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -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 diff --git a/gcc/ada/env.c b/gcc/ada/env.c index acd928ce86b..8115442cc9a 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 545175f8ffd..43802921247 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index dc4b03dcc98..ef50ec4b59d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 -- ----------------------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 95263ec84fd..b2c66ff2f30 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index fd509c482ae..abee1331106 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 5729924cceb..3d8e184b733 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -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); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index e582d7bac08..c7e6f474c88 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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. |