with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
+with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
with Sinfo; use Sinfo;
-- posted as required, and a value of No_Uint is returned.
function Is_Operational_Item (N : Node_Id) return Boolean;
- -- A specification for a stream attribute is allowed before the full
- -- type is declared, as explained in AI-00137 and the corrigendum.
- -- Attributes that do not specify a representation characteristic are
- -- operational attributes.
+ -- A specification for a stream attribute is allowed before the full type
+ -- is declared, as explained in AI-00137 and the corrigendum. Attributes
+ -- that do not specify a representation characteristic are operational
+ -- attributes.
procedure New_Stream_Subprogram
(N : Node_Id;
L : List_Id)
is
Aspect : Node_Id;
+ Aitem : Node_Id;
Ent : Node_Id;
- Result : Boolean;
- Ritem : Node_Id;
Ins_Node : Node_Id := N;
- -- Insert pragmas after this node
+ -- Insert pragmas (other than Pre/Post) after this node
+
+ -- The general processing involves building an attribute definition
+ -- clause or a pragma node that corresponds to the access type. Then
+ -- 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.
+
+ -- If no delay is required, we just insert the pragma or attribute
+ -- after the declaration, and it will get processed by the normal
+ -- circuit. The From_Aspect_Specification flag is set on the pragma
+ -- or attribute definition node in either case to activate special
+ -- processing (e.g. not traversing the list of homonyms for inline).
+
+ Delay_Required : Boolean;
+ -- Set True if delay is required
begin
if L = No_List then
Aspect := First (L);
while Present (Aspect) loop
declare
- Id : constant Node_Id := Identifier (Aspect);
- Expr : constant Node_Id := Expression (Aspect);
- Nam : constant Name_Id := Chars (Id);
+ Loc : constant Source_Ptr := Sloc (Aspect);
+ Id : constant Node_Id := Identifier (Aspect);
+ Expr : constant Node_Id := Expression (Aspect);
+ Nam : constant Name_Id := Chars (Id);
+ A_Id : constant Aspect_Id := Get_Aspect_Id (Nam);
Anod : Node_Id;
+ T : Entity_Id;
+
+ Eloc : Source_Ptr := Sloc (Expr);
+ -- Source location of expression, modified when we split PPC's
begin
- -- Check for duplicate aspect
+ Set_Entity (Aspect, E);
+ Ent := New_Occurrence_Of (E, Sloc (Id));
+
+ -- Check for duplicate aspect. Note that the Comes_From_Source
+ -- test allows duplicate Pre/Post's that we generate internally
+ -- to escape being flagged here.
Anod := First (L);
while Anod /= Aspect loop
- if Nam = Chars (Identifier (Anod)) then
+ if Nam = Chars (Identifier (Anod))
+ and then Comes_From_Source (Aspect)
+ then
Error_Msg_Name_1 := Nam;
Error_Msg_Sloc := Sloc (Anod);
- Error_Msg_NE
- ("aspect% for & ignored, already given at#", Id, E);
+
+ -- Case of same aspect specified twice
+
+ if Class_Present (Anod) = Class_Present (Aspect) then
+ if not Class_Present (Anod) then
+ Error_Msg_NE
+ ("aspect% for & previously given#",
+ Id, E);
+ else
+ Error_Msg_NE
+ ("aspect `%''Class` for & previously given#",
+ Id, E);
+ end if;
+
+ -- Case of Pre and Pre'Class both specified
+
+ elsif Nam = Name_Pre then
+ if Class_Present (Aspect) then
+ Error_Msg_NE
+ ("aspect `Pre''Class` for & is not allowed here",
+ Id, E);
+ Error_Msg_NE
+ ("\since aspect `Pre` previously given#",
+ Id, E);
+
+ else
+ Error_Msg_NE
+ ("aspect `Pre` for & is not allowed here",
+ Id, E);
+ Error_Msg_NE
+ ("\since aspect `Pre''Class` previously given#",
+ Id, E);
+ end if;
+ end if;
+
goto Continue;
end if;
-- Processing based on specific aspect
- case Get_Aspect_Id (Nam) is
+ case A_Id is
-- No_Aspect should be impossible
Aspect_Volatile |
Aspect_Volatile_Components =>
+ -- Build corresponding pragma node
+
+ Aitem :=
+ Make_Pragma (Loc,
+ Pragma_Argument_Associations => New_List (Ent),
+ Pragma_Identifier =>
+ Make_Identifier (Sloc (Id), Chars (Id)));
+
+ -- Deal with missing expression case, delay never needed
+
if No (Expr) then
- Result := True;
+ Delay_Required := False;
+
+ -- Expression is present
else
- Analyze_And_Resolve (Expr);
+ Preanalyze_Spec_Expression (Expr, Standard_Boolean);
- if not Is_OK_Static_Expression (Expr) then
- Error_Msg_N
- ("static boolean expression required here", Expr);
- Result := True;
+ -- If preanalysis gives a static expression, we don't
+ -- need to delay (this will happen often in practice).
- else
- Result := Is_True (Expr_Value (Expr));
- end if;
- end if;
+ if Is_OK_Static_Expression (Expr) then
+ Delay_Required := False;
- Ent := New_Occurrence_Of (E, Sloc (Id));
+ if Is_False (Expr_Value (Expr)) then
+ Set_Aspect_Cancel (Aitem);
+ end if;
- Ritem :=
- Make_Pragma (Sloc (Aspect),
- Pragma_Argument_Associations => New_List (Ent),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ -- If we don't get a static expression, then delay, the
+ -- expression may turn out static by freeze time.
- if Result = False then
- Set_Aspect_Cancel (Ritem);
+ else
+ Delay_Required := True;
+ end if;
end if;
- -- Aspects corresponding to attribute definition clauses. We
- -- create the matching clause and insert it following the
- -- declaration in the tree.
+ -- Aspects corresponding to attribute definition clauses with
+ -- the exception of Address which is treated specially.
when Aspect_Address |
Aspect_Alignment |
Aspect_Stream_Size |
Aspect_Value_Size =>
- Ritem :=
- Make_Attribute_Definition_Clause (Sloc (Aspect),
- Name => New_Occurrence_Of (E, Sloc (Id)),
+ -- Preanalyze the expression with the appropriate type
+
+ case A_Id is
+ 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 others =>
+ T := Any_Integer;
+ end case;
+
+ Preanalyze_Spec_Expression (Expr, T);
+
+ -- Construct the attribute definition clause
+
+ Aitem :=
+ Make_Attribute_Definition_Clause (Loc,
+ Name => Ent,
Chars => Chars (Id),
Expression => Relocate_Node (Expr));
+ -- We do not need a delay if we have a static expression
+
+ if Is_OK_Static_Expression (Expression (Aitem)) then
+ Delay_Required := False;
+
+ -- Here a delay is required
+
+ else
+ Delay_Required := True;
+ end if;
+
-- Aspects corresponding to pragmas with two arguments, where
-- the first argument is a local name referring to the entity,
-- and the second argument is the aspect definition expression.
when Aspect_Suppress |
Aspect_Unsuppress =>
- Ritem :=
- Make_Pragma (Sloc (Aspect),
+ -- Construct the pragma
+
+ Aitem :=
+ Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (E, Sloc (Expr)),
+ New_Occurrence_Of (E, Eloc),
Relocate_Node (Expr)),
Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ Make_Identifier (Sloc (Id), Chars (Id)));
+
+ -- We don't have to play the delay game here, since the only
+ -- values are check names which don't get analyzed anyway.
+
+ Delay_Required := False;
+
+ -- Aspects corresponding to stream routines
+
+ when Aspect_Input |
+ Aspect_Output |
+ Aspect_Read |
+ Aspect_Write =>
+
+ -- Construct the attribute definition clause
+
+ Aitem :=
+ Make_Attribute_Definition_Clause (Loc,
+ Name => Ent,
+ Chars => Chars (Id),
+ Expression => Relocate_Node (Expr));
+
+ -- These are always delayed (typically the subprogram that
+ -- is referenced cannot have been declared yet, since it has
+ -- a reference to the type for which this aspect is defined.
+
+ Delay_Required := True;
-- Aspects corresponding to pragmas with two arguments, where
-- the second argument is a local name referring to the entity,
when Aspect_Warnings =>
- Ritem :=
- Make_Pragma (Sloc (Aspect),
+ -- Construct the pragma
+
+ Aitem :=
+ Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
Relocate_Node (Expr),
- New_Occurrence_Of (E, Sloc (Expr))),
+ New_Occurrence_Of (E, Eloc)),
Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ Make_Identifier (Sloc (Id), Chars (Id)),
+ Class_Present => Class_Present (Aspect));
- -- Aspect Post corresponds to pragma Postcondition with single
- -- argument that is the expression (we never give a message
- -- argument. This is inserted right after the declaration, to
- -- to get the required pragma placement.
+ -- We don't have to play the delay game here, since the only
+ -- values are check names which don't get analyzed anyway.
- when Aspect_Post =>
+ Delay_Required := False;
- Insert_After (N,
- Make_Pragma (Sloc (Expr),
- Pragma_Argument_Associations => New_List (
- Relocate_Node (Expr)),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Postcondition)));
- goto Continue;
+ -- Aspects Pre/Post generate Precondition/Postcondition pragmas
+ -- with a first argument that is the expression, and a second
+ -- argument that is an informative message if the test fails.
+ -- This is inserted right after the declaration, to get the
+ -- required pragma placement.
- -- Aspect Pre corresponds to pragma Precondition with single
- -- argument that is the expression (we never give a message
- -- argument. This is inserted right after the declaration, to
- -- get the required pragma placement.
+ when Aspect_Pre | Aspect_Post => declare
+ Pname : Name_Id;
- when Aspect_Pre =>
+ begin
+ if A_Id = Aspect_Pre then
+ Pname := Name_Precondition;
+ else
+ Pname := Name_Postcondition;
+ end if;
- Insert_After (N,
- Make_Pragma (Sloc (Expr),
- Pragma_Argument_Associations => New_List (
- Relocate_Node (Expr)),
+ -- If the expressions is of the form A and then B, then
+ -- we generate separate Pre/Post aspects for the separate
+ -- clauses. Since we allow multiple pragmas, there is no
+ -- problem in allowing multiple Pre/Post aspects internally.
+
+ -- We do not do this for Pre'Class, since we have to put
+ -- these conditions together in a complex OR expression
+
+ if Pname = Name_Postcondition
+ or else not Class_Present (Aspect)
+ then
+ while Nkind (Expr) = N_And_Then loop
+ Insert_After (Aspect,
+ Make_Aspect_Specification (Sloc (Right_Opnd (Expr)),
+ Identifier => Identifier (Aspect),
+ Expression => Relocate_Node (Right_Opnd (Expr)),
+ Class_Present => Class_Present (Aspect),
+ Split_PPC => True));
+ Rewrite (Expr, Relocate_Node (Left_Opnd (Expr)));
+ Eloc := Sloc (Expr);
+ end loop;
+ end if;
+
+ -- Build the precondition/postcondition pragma
+
+ Aitem :=
+ Make_Pragma (Loc,
Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Precondition)));
+ Make_Identifier (Sloc (Id),
+ Chars => Pname),
+ Class_Present => Class_Present (Aspect),
+ Split_PPC => Split_PPC (Aspect),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Eloc,
+ Chars => Name_Check,
+ Expression => Relocate_Node (Expr))));
+
+ -- Add message unless exception messages are suppressed
+
+ if not Opt.Exception_Locations_Suppressed then
+ Append_To (Pragma_Argument_Associations (Aitem),
+ Make_Pragma_Argument_Association (Eloc,
+ Chars => Name_Message,
+ Expression =>
+ Make_String_Literal (Eloc,
+ Strval => "failed "
+ & Get_Name_String (Pname)
+ & " from "
+ & Build_Location_String (Eloc))));
+ end if;
+
+ Set_From_Aspect_Specification (Aitem, True);
+
+ -- For Pre/Post cases, insert immediately after the entity
+ -- declaration, since that is the required pragma placement.
+ -- Note that for these aspects, we do not have to worry
+ -- about delay issues, since the pragmas themselves deal
+ -- with delay of visibility for the expression analysis.
+
+ -- If the entity is a library-level subprogram, the pre/
+ -- postconditions must be treated as late pragmas.
+
+ if Nkind (Parent (N)) = N_Compilation_Unit then
+ Add_Global_Declaration (Aitem);
+ else
+ Insert_After (N, Aitem);
+ end if;
+
goto Continue;
+ end;
- -- Aspects currently unimplemented
+ -- Aspects currently unimplemented
when Aspect_Invariant |
Aspect_Predicate =>
goto Continue;
end case;
- Set_From_Aspect_Specification (Ritem);
- Insert_After (Ins_Node, Ritem);
- Ins_Node := Ritem;
+ Set_From_Aspect_Specification (Aitem, True);
+
+ -- If a delay is required, we delay the freeze (not much point in
+ -- delaying the aspect if we don't delay the freeze!). The pragma
+ -- or clause is then attached to the aspect specification which
+ -- is placed in the rep item list.
+
+ if Delay_Required then
+ Ensure_Freeze_Node (E);
+ Set_Is_Delayed_Aspect (Aitem);
+ Set_Has_Delayed_Aspects (E);
+ Set_Aspect_Rep_Item (Aspect, Aitem);
+ Record_Rep_Item (E, Aspect);
+
+ -- If no delay required, insert the pragma/clause in the tree
+
+ else
+ -- For Pre/Post cases, insert immediately after the entity
+ -- declaration, since that is the required pragma placement.
+
+ if A_Id = Aspect_Pre or else A_Id = Aspect_Post then
+ Insert_After (N, Aitem);
+
+ -- For all other cases, insert in sequence
+
+ else
+ Insert_After (Ins_Node, Aitem);
+ Ins_Node := Aitem;
+ end if;
+ end if;
end;
<<Continue>>
----------------------
function Duplicate_Clause return Boolean is
- A : constant Node_Id :=
- Get_Attribute_Definition_Clause
- (U_Ent, Get_Attribute_Id (Chars (N)));
+ A : Node_Id;
begin
- -- Nothing to do if this attribute definition clause comes from an
- -- aspect specification, since we could not be duplicating an
+ -- Nothing to do if this attribute definition clause comes from
+ -- an aspect specification, since we could not be duplicating an
-- explicit clause, and we dealt with the case of duplicated aspects
-- in Analyze_Aspect_Specifications.
return False;
end if;
- -- Otherwise current pragma may duplicate previous pragma or a
- -- previously given aspect specification for the same pragma.
+ -- Otherwise current clause may duplicate previous clause or a
+ -- previously given aspect specification for the same aspect.
+
+ A := Get_Rep_Item_For_Entity (U_Ent, Chars (N));
if Present (A) then
if Entity (A) = U_Ent then
Error_Msg_Name_1 := Chars (N);
Error_Msg_Sloc := Sloc (A);
- Error_Msg_NE ("aspect% for & previously specified#", N, U_Ent);
+ Error_Msg_NE ("aspect% for & previously given#", N, U_Ent);
return True;
end if;
end if;
elsif Csize /= No_Uint then
Check_Size (Expr, Ctyp, Csize, Biased);
- -- For the biased case, build a declaration for a subtype
- -- that will be used to represent the biased subtype that
- -- reflects the biased representation of components. We need
- -- this subtype to get proper conversions on referencing
- -- elements of the array. Note that component size clauses
- -- are ignored in VM mode.
+ -- For the biased case, build a declaration for a subtype that
+ -- will be used to represent the biased subtype that reflects
+ -- the biased representation of components. We need the subtype
+ -- to get proper conversions on referencing elements of the
+ -- array. Note: component size clauses are ignored in VM mode.
if VM_Target = No_VM then
if Biased then
OSDN Git Service
