diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-18 11:37:14 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-18 11:37:14 +0200 |
commit | 1fb000641146f78eb756228c6f5a64dc4c91b0ca (patch) | |
tree | 34f268f90e4345a88e0278633d604c1a38a29f31 | |
parent | a4485ef6398a741b55fa244546074f01cfdd83a4 (diff) | |
download | gcc-1fb000641146f78eb756228c6f5a64dc4c91b0ca.zip gcc-1fb000641146f78eb756228c6f5a64dc4c91b0ca.tar.gz gcc-1fb000641146f78eb756228c6f5a64dc4c91b0ca.tar.bz2 |
[multiple changes]
2010-10-18 Robert Dewar <dewar@adacore.com>
* g-trasym-vms-ia64.adb: Minor reformatting.
2010-10-18 Thomas Quinot <quinot@adacore.com>
* sem_type.adb (Covers): If either argument is Standard_Void_Type and
the other isn't, return False early.
2010-10-18 Ed Falis <falis@adacore.com>
* s-vxwext-rtp.ads, s-vxext-rtp.adb: Adapt for missing APIs for RTPs in
VxWorks Cert.
2010-10-18 Robert Dewar <dewar@adacore.com>
* sem_disp.ads: Minor comment update.
2010-10-18 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Spec_PPC_List): Is now present in Entries
* sem_ch3.adb (Analyze_Declarations): Add processing for delaying
visibility analysis of precondition and postcondition pragmas (and
Pre/Post aspects).
* sem_ch6.adb (Process_PPCs): Add handling of inherited Pre'Class
aspects.
* sem_ch7.adb (Analyze_Package_Specification): Remove special handling
of pre/post conditions (no longer needed).
* sem_disp.adb (Inherit_Subprograms): Deal with interface case.
* sem_prag.adb (Analyze_PPC_In_Decl_Part): Remove analysis of message
argument, since this is now done in the main processing for
pre/postcondition pragmas when they are first seen.
(Chain_PPC): Pre'Class and Post'Class now handled properly
(Chain_PPC): Handle Pre/Post aspects for entries
(Check_Precondition_Postcondition): Handle entry declaration case
(Check_Precondition_Postcondition): Handle delay of visibility analysis
(Check_Precondition_Postcondition): Preanalyze message argument if
present.
From-SVN: r165612
-rw-r--r-- | gcc/ada/ChangeLog | 39 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 10 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 12 | ||||
-rw-r--r-- | gcc/ada/g-trasym-vms-ia64.adb | 2 | ||||
-rw-r--r-- | gcc/ada/s-vxwext-rtp.adb | 13 | ||||
-rw-r--r-- | gcc/ada/s-vxwext-rtp.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 30 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 16 | ||||
-rw-r--r-- | gcc/ada/sem_ch7.adb | 36 | ||||
-rw-r--r-- | gcc/ada/sem_disp.adb | 72 | ||||
-rw-r--r-- | gcc/ada/sem_disp.ads | 5 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 53 | ||||
-rw-r--r-- | gcc/ada/sem_type.adb | 10 |
13 files changed, 211 insertions, 89 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5901659..256483c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,44 @@ 2010-10-18 Robert Dewar <dewar@adacore.com> + * g-trasym-vms-ia64.adb: Minor reformatting. + +2010-10-18 Thomas Quinot <quinot@adacore.com> + + * sem_type.adb (Covers): If either argument is Standard_Void_Type and + the other isn't, return False early. + +2010-10-18 Ed Falis <falis@adacore.com> + + * s-vxwext-rtp.ads, s-vxext-rtp.adb: Adapt for missing APIs for RTPs in + VxWorks Cert. + +2010-10-18 Robert Dewar <dewar@adacore.com> + + * sem_disp.ads: Minor comment update. + +2010-10-18 Robert Dewar <dewar@adacore.com> + + * einfo.ads, einfo.adb (Spec_PPC_List): Is now present in Entries + * sem_ch3.adb (Analyze_Declarations): Add processing for delaying + visibility analysis of precondition and postcondition pragmas (and + Pre/Post aspects). + * sem_ch6.adb (Process_PPCs): Add handling of inherited Pre'Class + aspects. + * sem_ch7.adb (Analyze_Package_Specification): Remove special handling + of pre/post conditions (no longer needed). + * sem_disp.adb (Inherit_Subprograms): Deal with interface case. + * sem_prag.adb (Analyze_PPC_In_Decl_Part): Remove analysis of message + argument, since this is now done in the main processing for + pre/postcondition pragmas when they are first seen. + (Chain_PPC): Pre'Class and Post'Class now handled properly + (Chain_PPC): Handle Pre/Post aspects for entries + (Check_Precondition_Postcondition): Handle entry declaration case + (Check_Precondition_Postcondition): Handle delay of visibility analysis + (Check_Precondition_Postcondition): Preanalyze message argument if + present. + +2010-10-18 Robert Dewar <dewar@adacore.com> + * g-trasym-vms-ia64.adb, prj-nmsc.adb, prj.ads: Minor reformatting. 2010-10-14 Eric Botcazou <ebotcazou@adacore.com> diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 8c58323..3c0314b 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -2581,7 +2581,10 @@ package body Einfo is function Spec_PPC_List (Id : E) return N is begin - pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id)); + pragma Assert + (Ekind (Id) = E_Entry + or else Is_Subprogram (Id) + or else Is_Generic_Subprogram (Id)); return Node24 (Id); end Spec_PPC_List; @@ -5046,7 +5049,10 @@ package body Einfo is procedure Set_Spec_PPC_List (Id : E; V : N) is begin - pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id)); + pragma Assert + (Ekind_In (Id, E_Entry, E_Void) + or else Is_Subprogram (Id) + or else Is_Generic_Subprogram (Id)); Set_Node24 (Id, V); end Set_Spec_PPC_List; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index ea2a208..c459f64 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3532,11 +3532,12 @@ package Einfo is -- the corresponding parameter entities in the spec. -- Spec_PPC_List (Node24) --- Present in subprogram and generic subprogram entities. Points to a --- list of Precondition and Postcondition pragma nodes for preconditions --- and postconditions declared in the spec. The last pragma encountered --- is at the head of this list, so it is in reverse order of textual --- appearance. +-- Present in entries, and in subprogram and generic subprogram entities. +-- Points to a list of Precondition and Postcondition pragma nodes for +-- preconditions and postconditions declared in the spec. The last pragma +-- encountered is at the head of this list, so it is in reverse order of +-- textual appearance. Note that this includes precondition/postcondition +-- pragmas generated to correspond to Pre/Post aspects. -- Storage_Size_Variable (Node15) [implementation base type only] -- Present in access types and task type entities. This flag is set @@ -4951,6 +4952,7 @@ package Einfo is -- Accept_Address (Elist21) -- Scope_Depth_Value (Uint22) -- Protection_Object (Node23) (protected kind) + -- Spec_PPC_List (Node24) (for entry only) -- Default_Expressions_Processed (Flag108) -- Entry_Accepted (Flag152) -- Is_AST_Entry (Flag132) (for entry only) diff --git a/gcc/ada/g-trasym-vms-ia64.adb b/gcc/ada/g-trasym-vms-ia64.adb index 508c18a..897e2eb 100644 --- a/gcc/ada/g-trasym-vms-ia64.adb +++ b/gcc/ada/g-trasym-vms-ia64.adb @@ -325,7 +325,7 @@ package body GNAT.Traceback.Symbolic is Len := Last; end; - -- Even status values + -- Failure (bit 0 clear) else Res (Len + 1 .. Len + 6) := "ERROR" & ASCII.LF; diff --git a/gcc/ada/s-vxwext-rtp.adb b/gcc/ada/s-vxwext-rtp.adb index b27238c..431f41e 100644 --- a/gcc/ada/s-vxwext-rtp.adb +++ b/gcc/ada/s-vxwext-rtp.adb @@ -26,7 +26,7 @@ -- -- ------------------------------------------------------------------------------ --- This package provides vxworks specific support functions needed +-- This package provides VxWorks specific support functions needed -- by System.OS_Interface. -- This is the VxWorks 6 RTP version of this package @@ -90,6 +90,17 @@ package body System.VxWorks.Ext is return 0; end Interrupt_Number_To_Vector; + --------------- + -- semDelete -- + --------------- + + function semDelete (Sem : SEM_ID) return int is + function OS_semDelete (Sem : SEM_ID) return int; + pragma Import (C, OS_semDelete, "semDelete"); + begin + return OS_semDelete (Sem); + end semDelete; + -------------------- -- Set_Time_Slice -- -------------------- diff --git a/gcc/ada/s-vxwext-rtp.ads b/gcc/ada/s-vxwext-rtp.ads index 7cfd48c..f1783c9 100644 --- a/gcc/ada/s-vxwext-rtp.ads +++ b/gcc/ada/s-vxwext-rtp.ads @@ -69,7 +69,7 @@ package System.VxWorks.Ext is pragma Convention (C, Interrupt_Number_To_Vector); function semDelete (Sem : SEM_ID) return int; - pragma Import (C, semDelete, "semDelete"); + pragma Convention (C, semDelete); function Task_Cont (tid : t_id) return int; pragma Import (C, Task_Cont, "taskResume"); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 41aced4..f78495a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -62,6 +62,7 @@ with Sem_Dist; use Sem_Dist; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Mech; use Sem_Mech; +with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Smem; use Sem_Smem; with Sem_Type; use Sem_Type; @@ -2069,6 +2070,35 @@ package body Sem_Ch3 is D := Next_Node; end loop; + + -- One more thing to do, we need to scan the declarations to check + -- for any precondition/postcondition pragmas (Pre/Post aspects have + -- by this stage been converted into corresponding pragmas). It is + -- at this point that we analyze the expressions in such pragmas, + -- to implement the delayed visibility requirement. + + declare + Decl : Node_Id; + Spec : Node_Id; + Sent : Entity_Id; + Prag : Node_Id; + + begin + Decl := First (L); + while Present (Decl) loop + if Nkind (Original_Node (Decl)) = N_Subprogram_Declaration then + Spec := Specification (Original_Node (Decl)); + Sent := Defining_Unit_Name (Spec); + Prag := Spec_PPC_List (Sent); + while Present (Prag) loop + Analyze_PPC_In_Decl_Part (Prag, Sent); + Prag := Next_Pragma (Prag); + end loop; + end if; + + Next (Decl); + end loop; + end; end Analyze_Declarations; ----------------------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 6d97ed1..bc228e4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8699,18 +8699,22 @@ package body Sem_Ch6 is -- do this fiddling, for the spec cases, the already preanalyzed -- parameters are not affected. + Set_Analyzed (CP, False); + + -- We also make sure Comes_From_Source is False for the copy + + Set_Comes_From_Source (CP, False); + -- For a postcondition pragma within a generic, preserve the pragma -- for later expansion. - Set_Analyzed (CP, False); - if Nam = Name_Postcondition and then not Expander_Active then return CP; end if; - -- Change pragma into corresponding pragma Check + -- Change copy of pragma into corresponding pragma Check Prepend_To (Pragma_Argument_Associations (CP), Make_Pragma_Argument_Association (Sloc (Prag), @@ -8761,9 +8765,8 @@ package body Sem_Ch6 is Prag := Spec_PPC_List (Spec_Id); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Precondition - and then Pragma_Enabled (Prag) - then + if Pragma_Name (Prag) = Name_Precondition then + -- For Pre (or Precondition pragma), we simply prepend the -- pragma to the list of declarations right away so that it -- will be executed at the start of the procedure. Note that @@ -8969,7 +8972,6 @@ package body Sem_Ch6 is Prag := Spec_PPC_List (Spec); loop if Pragma_Name (Prag) = Name_Postcondition - and then Pragma_Enabled (Prag) and then (not Class or else Class_Present (Prag)) then if Plist = No_List then diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index e355552..e53fb55 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -55,7 +55,6 @@ with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; with Sem_Eval; use Sem_Eval; -with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Snames; use Snames; @@ -872,12 +871,6 @@ package body Sem_Ch7 is -- private_with_clauses, and remove them at the end of the nested -- package. - procedure Analyze_PPCs (Decls : List_Id); - -- Given a list of declarations, go through looking for subprogram - -- specs, and for each one found, analyze any pre/postconditions that - -- are chained to the spec. This is the implementation of the late - -- visibility analysis for preconditions and postconditions in specs. - procedure Clear_Constants (Id : Entity_Id; FE : Entity_Id); -- Clears constant indications (Never_Set_In_Source, Constant_Value, and -- Is_True_Constant) on all variables that are entities of Id, and on @@ -906,33 +899,6 @@ package body Sem_Ch7 is -- private part rather than being done in Sem_Ch12.Install_Parent -- (which is where the parents' visible declarations are installed). - ------------------ - -- Analyze_PPCs -- - ------------------ - - procedure Analyze_PPCs (Decls : List_Id) is - Decl : Node_Id; - Spec : Node_Id; - Sent : Entity_Id; - Prag : Node_Id; - - begin - Decl := First (Decls); - while Present (Decl) loop - if Nkind (Original_Node (Decl)) = N_Subprogram_Declaration then - Spec := Specification (Original_Node (Decl)); - Sent := Defining_Unit_Name (Spec); - Prag := Spec_PPC_List (Sent); - while Present (Prag) loop - Analyze_PPC_In_Decl_Part (Prag, Sent); - Prag := Next_Pragma (Prag); - end loop; - end if; - - Next (Decl); - end loop; - end Analyze_PPCs; - --------------------- -- Clear_Constants -- --------------------- @@ -1161,7 +1127,6 @@ package body Sem_Ch7 is begin if Present (Vis_Decls) then Analyze_Declarations (Vis_Decls); - Analyze_PPCs (Vis_Decls); end if; -- Verify that incomplete types have received full declarations @@ -1296,7 +1261,6 @@ package body Sem_Ch7 is end if; Analyze_Declarations (Priv_Decls); - Analyze_PPCs (Priv_Decls); -- Check the private declarations for incomplete deferred constants diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index c7afc3f..322e535 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1742,8 +1742,29 @@ package body Sem_Disp is Parent_Op : Entity_Id; -- Traverses the Overridden_Operation chain + procedure Store_IS (E : Entity_Id); + -- Stores E in Result if not already stored + + -------------- + -- Store_IS -- + -------------- + + procedure Store_IS (E : Entity_Id) is + begin + for J in 1 .. N loop + if E = Result (J) then + return; + end if; + end loop; + + N := N + 1; + Result (N) := E; + end Store_IS; + + -- Start of processing for Inherited_Subprograms + begin - if Present (S) then + if Present (S) and then Is_Dispatching_Operation (S) then -- Deal with direct inheritance @@ -1755,13 +1776,56 @@ package body Sem_Disp is if Is_Subprogram (Parent_Op) or else Is_Generic_Subprogram (Parent_Op) then - N := N + 1; - Result (N) := Parent_Op; + Store_IS (Parent_Op); end if; end loop; - -- For now don't bother with interfaces, TBD ??? + -- Now deal with interfaces + + declare + Tag_Typ : Entity_Id; + Prim : Entity_Id; + Elmt : Elmt_Id; + + begin + Tag_Typ := Find_Dispatching_Type (S); + + if Is_Concurrent_Type (Tag_Typ) then + Tag_Typ := Corresponding_Record_Type (Tag_Typ); + end if; + -- Search primitive operations of dispatching type + + if Present (Tag_Typ) + and then Present (Primitive_Operations (Tag_Typ)) + then + Elmt := First_Elmt (Primitive_Operations (Tag_Typ)); + while Present (Elmt) loop + Prim := Node (Elmt); + + -- The following test eliminates some odd cases in which + -- Ekind (Prim) is Void, to be investigated further ??? + + if not (Is_Subprogram (Prim) + or else + Is_Generic_Subprogram (Prim)) + then + null; + + -- For [generic] subprogram, look at interface alias + + elsif Present (Interface_Alias (Prim)) + and then Alias (Prim) = S + then + -- We have found a primitive covered by S + + Store_IS (Interface_Alias (Prim)); + end if; + + Next_Elmt (Elmt); + end loop; + end if; + end; end if; return Result (1 .. N); diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index ddd7a89..66a0251 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -76,8 +76,9 @@ package Sem_Disp is -- and Empty if it is not dynamically tagged. function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id; - -- Check whether a subprogram is dispatching, and find the tagged - -- type of the controlling argument or arguments. + -- Check whether a subprogram is dispatching, and find the tagged type of + -- the controlling argument or arguments. Returns Empty if Subp is not a + -- dispatching operation. function Find_Primitive_Covering_Interface (Tagged_Type : Entity_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 33cfe01..516ebc9 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -240,9 +240,7 @@ package body Sem_Prag is ------------------------------ procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id) is - Arg1 : constant Node_Id := - First (Pragma_Argument_Associations (N)); - Arg2 : constant Node_Id := Next (Arg1); + Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); begin -- Install formals and push subprogram spec onto scope stack so that we @@ -257,13 +255,6 @@ package body Sem_Prag is Preanalyze_Spec_Expression (Get_Pragma_Arg (Arg1), Standard_Boolean); - -- If there is a message argument, analyze it the same way - - if Present (Arg2) then - Preanalyze_Spec_Expression - (Get_Pragma_Arg (Arg2), Standard_String); - end if; - -- Remove the subprogram from the scope stack now that the pre-analysis -- of the precondition/postcondition is done. @@ -1511,8 +1502,7 @@ package body Sem_Prag is ("pragma% cannot be applied to abstract subprogram"); elsif Class_Present (N) then - Error_Pragma - ("aspect `%''Class` not implemented yet"); + null; else Error_Pragma @@ -1520,14 +1510,19 @@ package body Sem_Prag is end if; elsif not Nkind_In (PO, N_Subprogram_Declaration, - N_Generic_Subprogram_Declaration) + N_Generic_Subprogram_Declaration, + N_Entry_Declaration) then Pragma_Misplaced; end if; - -- Here if we have subprogram or generic subprogram declaration + -- Here if we have [generic] subprogram or entry declaration - S := Defining_Unit_Name (Specification (PO)); + if Nkind (PO) = N_Entry_Declaration then + S := Defining_Entity (PO); + else + S := Defining_Unit_Name (Specification (PO)); + end if; -- Make sure we do not have the case of a precondition pragma when -- the Pre'Class aspect is present. @@ -1583,14 +1578,11 @@ package body Sem_Prag is end; end if; - -- Analyze the pragma unless it appears within a package spec, - -- which is the case where we delay the analysis of the PPC until - -- the end of the package declarations (for details, see - -- Analyze_Package_Specification.Analyze_PPCs). - - if not Is_Package_Or_Generic_Package (Scope (S)) then - Analyze_PPC_In_Decl_Part (N, S); - end if; + -- Note: we do not analye the pragma at this point. Instead we + -- delay this analysis until the end of the declarative part in + -- which the pragma appears. This implements the required delay + -- in this analysis, allowing forward references. The analysis + -- happens at the end of Analyze_Declarations. -- Chain spec PPC pragma to list for subprogram @@ -1610,6 +1602,15 @@ package body Sem_Prag is Pragma_Misplaced; end if; + -- Preanalyze message argument if present. Visibility in this + -- argument is established at the point of pragma occurrence. + + if Arg_Count = 2 then + Check_Optional_Identifier (Arg2, Name_Message); + Preanalyze_Spec_Expression + (Get_Pragma_Arg (Arg2), Standard_String); + end if; + -- Record if pragma is enabled if Check_Enabled (Pname) then @@ -10823,7 +10824,6 @@ package body Sem_Prag is Check_At_Least_N_Arguments (1); Check_At_Most_N_Arguments (2); Check_Optional_Identifier (Arg1, Name_Check); - Check_Precondition_Postcondition (In_Body); -- If in spec, nothing more to do. If in body, then we convert the @@ -10833,11 +10833,6 @@ package body Sem_Prag is -- analyze the condition itself in the proper context. if In_Body then - if Arg_Count = 2 then - Check_Optional_Identifier (Arg3, Name_Message); - Analyze_And_Resolve (Get_Pragma_Arg (Arg2), Standard_String); - end if; - Rewrite (N, Make_Pragma (Loc, Chars => Name_Check, diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index f082127..08d273e 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -755,6 +755,14 @@ package body Sem_Type is end if; end if; + -- First check for Standard_Void_Type, which is special. Subsequent + -- processing in this routine assumes T1 and T2 are bona fide types; + -- Standard_Void_Type is a special entity that has some, but not all, + -- properties of types. + + if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then + return False; + -- Simplest case: same types are compatible, and types that have the -- same base type and are not generic actuals are compatible. Generic -- actuals belong to their class but are not compatible with other @@ -770,7 +778,7 @@ package body Sem_Type is -- the same actual, so that different subprograms end up with the same -- signature in the instance. - if T1 = T2 then + elsif T1 = T2 then return True; elsif BT1 = BT2 |