* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165612
138bc75d-0d04-0410-961f-
82ee72b054a4
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>
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;
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;
-- 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
-- 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)
Len := Last;
end;
- -- Even status values
+ -- Failure (bit 0 clear)
else
Res (Len + 1 .. Len + 6) := "ERROR" & ASCII.LF;
-- --
------------------------------------------------------------------------------
--- 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
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 --
--------------------
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");
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;
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;
-----------------------------------
-- 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),
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
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
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;
-- 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
-- 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 --
---------------------
begin
if Present (Vis_Decls) then
Analyze_Declarations (Vis_Decls);
- Analyze_PPCs (Vis_Decls);
end if;
-- Verify that incomplete types have received full declarations
end if;
Analyze_Declarations (Priv_Decls);
- Analyze_PPCs (Priv_Decls);
-- Check the private declarations for incomplete deferred constants
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
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);
-- 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;
------------------------------
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
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.
("pragma% cannot be applied to abstract subprogram");
elsif Class_Present (N) then
- Error_Pragma
- ("aspect `%''Class` not implemented yet");
+ null;
else
Error_Pragma
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.
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
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
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
-- 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,
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
-- 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
OSDN Git Service
