aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch13.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_ch13.adb')
-rw-r--r--gcc/ada/sem_ch13.adb579
1 files changed, 510 insertions, 69 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 072ec66..1e88ef4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -29,11 +29,11 @@ with Atree; use Atree;
with Checks; use Checks;
with Contracts; use Contracts;
with Debug; use Debug;
-with Diagnostics.Constructors; use Diagnostics.Constructors;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
+with Errid; use Errid;
with Errout; use Errout;
with Exp_Ch3; use Exp_Ch3;
with Exp_Disp; use Exp_Disp;
@@ -54,6 +54,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
+with Sem_Aggr; use Sem_Aggr;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Cat; use Sem_Cat;
@@ -1620,6 +1621,7 @@ package body Sem_Ch13 is
-- Part_Of
-- Post
-- Pre
+ -- Program_Exit
-- Refined_Depends
-- Refined_Global
-- Refined_Post
@@ -1872,11 +1874,11 @@ package body Sem_Ch13 is
-- analyzed right now.
-- Note that there is a special handling for Pre, Post, Test_Case,
- -- Contract_Cases, Always_Terminates, Exit_Cases, Exceptional_Cases and
- -- Subprogram_Variant aspects. In these cases, we do not have to worry
- -- about delay issues, since the pragmas themselves deal with delay of
- -- visibility for the expression analysis. Thus, we just insert the
- -- pragma after the node N.
+ -- Contract_Cases, Always_Terminates, Exit_Cases, Exceptional_Cases,
+ -- Program_Exit and Subprogram_Variant aspects. In these cases, we do
+ -- not have to worry about delay issues, since the pragmas themselves
+ -- deal with delay of visibility for the expression analysis. Thus, we
+ -- just insert the pragma after the node N.
if No (L) then
return;
@@ -1928,6 +1930,9 @@ package body Sem_Ch13 is
procedure Analyze_Aspect_Implicit_Dereference;
-- Perform analysis of the Implicit_Dereference aspects
+ procedure Analyze_Aspect_Potentially_Invalid;
+ -- Perform analysis of aspect Potentially_Invalid
+
procedure Analyze_Aspect_Relaxed_Initialization;
-- Perform analysis of aspect Relaxed_Initialization
@@ -2295,6 +2300,267 @@ package body Sem_Ch13 is
end Analyze_Aspect_Implicit_Dereference;
+ ----------------------------------------
+ -- Analyze_Aspect_Potentially_Invalid --
+ ----------------------------------------
+
+ procedure Analyze_Aspect_Potentially_Invalid is
+ procedure Analyze_Aspect_Parameter
+ (Subp_Id : Entity_Id;
+ Param : Node_Id;
+ Seen : in out Elist_Id);
+ -- Analyze parameter that appears in the expression of the
+ -- aspect Potentially_Invalid.
+
+ ------------------------------
+ -- Analyze_Aspect_Parameter --
+ ------------------------------
+
+ procedure Analyze_Aspect_Parameter
+ (Subp_Id : Entity_Id;
+ Param : Node_Id;
+ Seen : in out Elist_Id)
+ is
+ begin
+ -- Set name of the aspect for error messages
+ Error_Msg_Name_1 := Nam;
+
+ -- The potentially invalid parameter is a formal parameter
+
+ if Nkind (Param) in N_Identifier | N_Expanded_Name then
+ Analyze (Param);
+
+ declare
+ Item : constant Entity_Id := Entity (Param);
+ begin
+ -- It must be a formal of the analyzed subprogram
+
+ if Scope (Item) = Subp_Id then
+
+ pragma Assert (Is_Formal (Item));
+
+ -- It must not have scalar type
+
+ if Is_Scalar_Type (Underlying_Type (Etype (Item)))
+ then
+ Error_Msg_N ("illegal aspect % item", Param);
+ Error_Msg_N
+ ("\item must not have scalar type", Param);
+ end if;
+
+ -- Detect duplicated items
+
+ if Contains (Seen, Item) then
+ Error_Msg_N ("duplicate aspect % item", Param);
+ else
+ Append_New_Elmt (Item, Seen);
+ end if;
+ else
+ Error_Msg_N ("illegal aspect % item", Param);
+ end if;
+ end;
+
+ -- The potentially invalid parameter is the function's
+ -- Result attribute.
+
+ elsif Is_Attribute_Result (Param) then
+ Analyze (Param);
+
+ declare
+ Pref : constant Node_Id := Prefix (Param);
+ begin
+ if Present (Pref)
+ and then
+ Nkind (Pref) in N_Identifier | N_Expanded_Name
+ and then
+ Entity (Pref) = Subp_Id
+ then
+ -- Detect duplicated items
+
+ if Contains (Seen, Subp_Id) then
+ Error_Msg_N ("duplicate aspect % item", Param);
+ else
+ Append_New_Elmt (Entity (Pref), Seen);
+ end if;
+
+ else
+ Error_Msg_N ("illegal aspect % item", Param);
+ end if;
+ end;
+ else
+ Error_Msg_N ("illegal aspect % item", Param);
+ end if;
+ end Analyze_Aspect_Parameter;
+
+ -- Local variables
+
+ Seen : Elist_Id := No_Elist;
+ -- Items that appear in the potentially invalid aspect
+ -- expression of a subprogram; for detecting duplicates.
+
+ Restore_Scope : Boolean;
+ -- Will be set to True if we need to restore the scope table
+ -- after analyzing the aspect expression.
+
+ -- Start of processing for Analyze_Aspect_Potentially_Invalid
+
+ begin
+ -- Set name of the aspect for error messages
+ Error_Msg_Name_1 := Nam;
+
+ -- Annotation of a variable; no aspect expression is allowed
+
+ if Ekind (E) = E_Variable then
+ if Present (Expr) then
+ Error_Msg_N ("illegal aspect % expression", Expr);
+ end if;
+
+ -- Annotation of a constant; no aspect expression is allowed.
+ -- For a deferred constant, the aspect must be attached to the
+ -- partial view.
+
+ elsif Ekind (E) = E_Constant then
+ if Present (Incomplete_Or_Partial_View (E)) then
+ Error_Msg_N
+ ("aspect % must apply to deferred constant", N);
+
+ elsif Present (Expr) then
+ Error_Msg_N ("illegal aspect % expression", Expr);
+ end if;
+
+ -- Annotation of a subprogram; aspect expression is required
+
+ elsif Is_Subprogram_Or_Entry (E)
+ or else Is_Generic_Subprogram (E)
+ then
+
+ -- Not allowed for renaming declarations. Examine the
+ -- original node because a subprogram renaming may have been
+ -- rewritten as a body.
+
+ if Nkind (Original_Node (N)) in N_Renaming_Declaration then
+ Error_Msg_N
+ ("aspect % not allowed for renaming declaration",
+ Aspect);
+ end if;
+
+ if Present (Expr) then
+
+ -- If we analyze subprogram body that acts as its own
+ -- spec, then the subprogram itself and its formals are
+ -- already installed; otherwise, we need to install them,
+ -- as they must be visible when analyzing the aspect
+ -- expression.
+
+ if In_Open_Scopes (E) then
+ Restore_Scope := False;
+ else
+ Restore_Scope := True;
+ Push_Scope (E);
+
+ -- Only formals of the subprogram itself can appear
+ -- in Potentially_Invalid aspect expression, not
+ -- formals of the enclosing generic unit. (This is
+ -- different than in Precondition or Depends aspects,
+ -- where both kinds of formals are allowed.)
+
+ Install_Formals (E);
+ end if;
+
+ -- Aspect expression is either an aggregate with list of
+ -- parameters (and possibly the Result attribute for a
+ -- function).
+
+ if Nkind (Expr) = N_Aggregate then
+
+ -- Component associations in the aggregate must be a
+ -- parameter name followed by a static boolean
+ -- expression.
+
+ if Present (Component_Associations (Expr)) then
+ declare
+ Assoc : Node_Id :=
+ First (Component_Associations (Expr));
+ begin
+ while Present (Assoc) loop
+ if List_Length (Choices (Assoc)) = 1 then
+ Analyze_Aspect_Parameter
+ (E, First (Choices (Assoc)), Seen);
+
+ if Inside_A_Generic then
+ Preanalyze_And_Resolve
+ (Expression (Assoc), Any_Boolean);
+ else
+ Analyze_And_Resolve
+ (Expression (Assoc), Any_Boolean);
+ end if;
+
+ if not Is_OK_Static_Expression
+ (Expression (Assoc))
+ then
+ Error_Msg_Name_1 := Nam;
+ Flag_Non_Static_Expr
+ ("expression of aspect % " &
+ "must be static!", Aspect);
+ end if;
+
+ else
+ Error_Msg_Name_1 := Nam;
+ Error_Msg_N
+ ("illegal aspect % expression", Expr);
+ end if;
+ Next (Assoc);
+ end loop;
+ end;
+ end if;
+
+ -- Expressions of the aggregate are parameter names
+
+ if Present (Expressions (Expr)) then
+ declare
+ Param : Node_Id := First (Expressions (Expr));
+
+ begin
+ while Present (Param) loop
+ Analyze_Aspect_Parameter (E, Param, Seen);
+ Next (Param);
+ end loop;
+ end;
+ end if;
+
+ -- Mark the aggregate expression itself as analyzed;
+ -- its subexpressions were marked when they themselves
+ -- were analyzed.
+
+ Set_Analyzed (Expr);
+
+ -- Otherwise, it is a single name of a subprogram
+ -- parameter (or possibly the Result attribute for
+ -- a function).
+
+ else
+ Analyze_Aspect_Parameter (E, Expr, Seen);
+ end if;
+
+ if Restore_Scope then
+ End_Scope;
+ end if;
+
+ -- For instances of Ada.Unchecked_Conversion, allow a
+ -- parameterless aspect, as the 'Result attribute is not
+ -- defined there.
+
+ elsif Is_Unchecked_Conversion_Instance (E) then
+ null;
+ else
+ Error_Msg_N ("missing expression for aspect %", N);
+ end if;
+
+ else
+ Error_Msg_N ("inappropriate entity for aspect %", E);
+ end if;
+ end Analyze_Aspect_Potentially_Invalid;
+
-------------------------------------------
-- Analyze_Aspect_Relaxed_Initialization --
-------------------------------------------
@@ -3873,6 +4139,89 @@ package body Sem_Ch13 is
goto Continue;
end Initial_Condition;
+ -- Initialize
+
+ when Aspect_Initialize => Initialize : declare
+ Aspect_Comp : Node_Id;
+ Type_Comp : Node_Id;
+ Typ : Entity_Id;
+ Dummy_Aggr : Node_Id;
+ begin
+ -- Error checking
+
+ if not All_Extensions_Allowed then
+ goto Continue;
+ end if;
+
+ if Ekind (E) /= E_Procedure then
+ Error_Msg_N ("Initialize must apply to a constructor", N);
+ end if;
+
+ if Present (Expressions (Expression (Aspect))) then
+ Error_Msg_N ("only component associations allowed", N);
+ end if;
+
+ -- Install the others for the aggregate if necessary
+
+ Typ := Etype (First_Entity (E));
+
+ if No (First_Entity (Typ)) then
+ Error_Msg_N
+ ("Initialize can only apply to contructors"
+ & " whose type has one or more components", N);
+ end if;
+
+ Aspect_Comp :=
+ First (Component_Associations (Expression (Aspect)));
+ Type_Comp := First_Entity (Typ);
+ while Present (Type_Comp) loop
+ if No (Aspect_Comp) then
+ Append_To
+ (Component_Associations (Expression (Aspect)),
+ Make_Component_Association (Loc,
+ Choices =>
+ New_List (Make_Others_Choice (Loc)),
+ Box_Present => True));
+ exit;
+ elsif Nkind (First (Choices (Aspect_Comp)))
+ = N_Others_Choice
+ then
+ exit;
+ end if;
+
+ Next (Aspect_Comp);
+ Next_Entity (Type_Comp);
+ end loop;
+
+ -- Push the scope and formals for analysis
+
+ Push_Scope (E);
+ Install_Formals (Defining_Unit_Name (Specification (N)));
+
+ -- Analyze the components
+
+ Aspect_Comp :=
+ First (Component_Associations (Expression (Aspect)));
+ while Present (Aspect_Comp) loop
+ if Present (Expression (Aspect_Comp)) then
+ Analyze (Expression (Aspect_Comp));
+ end if;
+
+ Next (Aspect_Comp);
+ end loop;
+
+ -- Do a psuedo pass over the aggregate to ensure it is valid
+
+ Expander_Active := False;
+ Dummy_Aggr := New_Copy_Tree (Expression (Aspect));
+ Resolve_Aggregate (Dummy_Aggr, Typ);
+ Expander_Active := True;
+
+ -- Return the scope
+
+ End_Scope;
+ end Initialize;
+
-- Initializes
-- Aspect Initializes is never delayed because it is equivalent
@@ -3990,6 +4339,12 @@ package body Sem_Ch13 is
goto Continue;
+ -- Potentially_Invalid
+
+ when Aspect_Potentially_Invalid =>
+ Analyze_Aspect_Potentially_Invalid;
+ goto Continue;
+
-- SPARK_Mode
when Aspect_SPARK_Mode =>
@@ -4346,6 +4701,10 @@ package body Sem_Ch13 is
Analyze_Aspect_Implicit_Dereference;
goto Continue;
+ when Aspect_Constructor =>
+ Set_Constructor_Name (E, Expr);
+ Set_Needs_Construction (E);
+
-- Dimension
when Aspect_Dimension =>
@@ -4366,8 +4725,9 @@ package body Sem_Ch13 is
-- Case 4: Aspects requiring special handling
-- Pre/Post/Test_Case/Contract_Cases/Always_Terminates/
- -- Exceptional_Cases/Exit_Cases and Subprogram_Variant whose
- -- corresponding pragmas take care of the delay.
+ -- Exceptional_Cases/Exit_Cases/Program_Exit and
+ -- Subprogram_Variant whose corresponding pragmas take care of
+ -- the delay.
-- Pre/Post
@@ -4573,6 +4933,19 @@ package body Sem_Ch13 is
Insert_Pragma (Aitem);
goto Continue;
+ -- Program_Exit
+
+ when Aspect_Program_Exit =>
+ Aitem := Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Program_Exit);
+
+ Decorate (Aspect, Aitem);
+ Insert_Pragma (Aitem);
+ goto Continue;
+
-- Subprogram_Variant
when Aspect_Subprogram_Variant =>
@@ -6105,6 +6478,7 @@ package body Sem_Ch13 is
declare
Expr : constant Node_Id := Expression (N);
O_Ent : Entity_Id;
+ O_Typ : Entity_Id;
Off : Boolean;
begin
@@ -6117,7 +6491,7 @@ package body Sem_Ch13 is
return;
end if;
- Find_Overlaid_Entity (N, O_Ent, Off);
+ Find_Overlaid_Entity (N, O_Ent, O_Typ, Off);
if Present (O_Ent) then
@@ -6170,10 +6544,10 @@ package body Sem_Ch13 is
if (Is_Record_Type (Etype (U_Ent))
or else Is_Array_Type (Etype (U_Ent)))
- and then (Is_Record_Type (Etype (O_Ent))
- or else Is_Array_Type (Etype (O_Ent)))
+ and then (Is_Record_Type (O_Typ)
+ or else Is_Array_Type (O_Typ))
and then Reverse_Storage_Order (Etype (U_Ent)) /=
- Reverse_Storage_Order (Etype (O_Ent))
+ Reverse_Storage_Order (O_Typ)
then
Error_Msg_N
("??overlay changes scalar storage order", Expr);
@@ -6278,11 +6652,6 @@ package body Sem_Ch13 is
then
Set_Check_Address_Alignment (N);
end if;
-
- -- Kill the size check code, since we are not allocating
- -- the variable, it is somewhere else.
-
- Kill_Size_Check_Code (U_Ent);
end;
-- Not a valid entity for an address clause
@@ -6502,7 +6871,8 @@ package body Sem_Ch13 is
-- and restored before and after analysis.
Push_Type (U_Ent);
- Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Expr, RTE (RE_CPU_Range));
Pop_Type (U_Ent);
-- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU":
@@ -6592,10 +6962,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
-
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expr, RTE (RE_Dispatching_Domain));
-
Pop_Type (U_Ent);
end if;
@@ -6674,10 +7042,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
-
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expr, RTE (RE_Interrupt_Priority));
-
Pop_Type (U_Ent);
-- Check the No_Task_At_Interrupt_Priority restriction
@@ -6843,7 +7209,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
- Preanalyze_Spec_Expression (Expr, Standard_Integer);
+ Preanalyze_And_Resolve_Spec_Expression
+ (Expr, Standard_Integer);
Pop_Type (U_Ent);
if not Is_OK_Static_Expression (Expr) then
@@ -7154,7 +7521,7 @@ package body Sem_Ch13 is
else
Small := Expr_Value_R (Expr);
- if Small <= Ureal_0 then
+ if not UR_Is_Positive (Small) then
Error_Msg_N ("small value must be greater than zero", Expr);
return;
end if;
@@ -9889,6 +10256,12 @@ package body Sem_Ch13 is
-- Includes a call to the predicate function for type T in Expr if
-- Predicate_Function (T) is non-empty.
+ function Has_Source_Predicate (T : Entity_Id) return Boolean;
+ -- Return True if one of the 3 predicate aspects is specified
+ -- explicitly (either via a pragma or an aspect specification, but
+ -- not implicitly via propagation from some other type/subtype via
+ -- RM 3.2.4(5)) for the type/subtype T.
+
procedure Replace_Current_Instance_References
(N : Node_Id; Typ, New_Entity : Entity_Id);
-- Replace all references to Typ in the tree rooted at N with
@@ -10039,8 +10412,8 @@ package body Sem_Ch13 is
-- If the predicate pragma comes from an aspect, replace the
-- saved expression because we need the subtype references
- -- replaced for the calls to Preanalyze_Spec_Expression in
- -- Check_Aspect_At_xxx routines.
+ -- replaced for the calls to Preanalyze_And_Resolve_Spec_
+ -- Expression in Check_Aspect_At_xxx routines.
if Present (Asp) then
Set_Expression_Copy (Asp, New_Copy_Tree (Arg2_Copy));
@@ -10105,6 +10478,41 @@ package body Sem_Ch13 is
end loop;
end Add_Predicates;
+ --------------------------
+ -- Has_Source_Predicate --
+ --------------------------
+
+ function Has_Source_Predicate (T : Entity_Id) return Boolean is
+ Rep_Item : Node_Id := First_Rep_Item (T);
+ begin
+ while Present (Rep_Item) loop
+ case Nkind (Rep_Item) is
+ when N_Pragma =>
+ if Get_Pragma_Id (Rep_Item) = Pragma_Predicate
+ and then T = Entity (Expression
+ (First (Pragma_Argument_Associations (Rep_Item))))
+ then
+ return True;
+ end if;
+
+ when N_Aspect_Specification =>
+ if Get_Aspect_Id (Rep_Item) in
+ Aspect_Static_Predicate
+ | Aspect_Dynamic_Predicate | Aspect_Predicate
+ and then Entity (Rep_Item) = T
+ then
+ return True;
+ end if;
+
+ when others =>
+ null;
+ end case;
+
+ Next_Rep_Item (Rep_Item);
+ end loop;
+ return False;
+ end Has_Source_Predicate;
+
-----------------------------------------
-- Replace_Current_Instance_References --
-----------------------------------------
@@ -10148,6 +10556,21 @@ package body Sem_Ch13 is
-- context where expansion and tests are enabled.
SId := Predicate_Function (Typ);
+
+ -- When declaring a subtype S whose "predecessor" subtype PS (that is,
+ -- the subtype denoted by the subtype_mark in the declaration of S)
+ -- already has a predicate function, do not confuse that existing
+ -- function for PS with the function we need to build for S if
+ -- Has_Source_Predicate returns True for S.
+
+ if Present (SId)
+ and then Nkind (Parent (Typ)) = N_Subtype_Declaration
+ and then Etype (First_Entity (SId)) /= Typ
+ and then Has_Source_Predicate (Typ)
+ then
+ SId := Empty;
+ end if;
+
if not Has_Predicates (Typ)
or else (Present (SId) and then Has_Completion (SId))
or else
@@ -10806,7 +11229,8 @@ package body Sem_Ch13 is
-- name, so we need to verify that one of these interpretations is
-- the one available at at the freeze point.
- elsif A_Id in Aspect_Input
+ elsif A_Id in Aspect_Constructor
+ | Aspect_Input
| Aspect_Output
| Aspect_Read
| Aspect_Write
@@ -10853,12 +11277,14 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean);
+ Preanalyze_And_Resolve_Spec_Expression
+ (Freeze_Expr, Standard_Boolean);
Pop_Type (Ent);
elsif A_Id = Aspect_Priority then
Push_Type (Ent);
- Preanalyze_Spec_Expression (Freeze_Expr, Any_Integer);
+ Preanalyze_And_Resolve_Spec_Expression
+ (Freeze_Expr, Any_Integer);
Pop_Type (Ent);
else
@@ -10908,7 +11334,8 @@ package body Sem_Ch13 is
elsif A_Id in Aspect_Default_Component_Value | Aspect_Default_Value
and then Is_Private_Type (T)
then
- Preanalyze_Spec_Expression (End_Decl_Expr, Full_View (T));
+ Preanalyze_And_Resolve_Spec_Expression
+ (End_Decl_Expr, Full_View (T));
-- The following aspect expressions may contain references to
-- components and discriminants of the type.
@@ -10922,14 +11349,15 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve_Spec_Expression (End_Decl_Expr, T);
Pop_Type (Ent);
elsif A_Id = Aspect_Predicate_Failure then
- Preanalyze_Spec_Expression (End_Decl_Expr, Standard_String);
+ Preanalyze_And_Resolve_Spec_Expression
+ (End_Decl_Expr, Standard_String);
elsif Present (End_Decl_Expr) then
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve_Spec_Expression (End_Decl_Expr, T);
end if;
Err :=
@@ -11112,7 +11540,8 @@ package body Sem_Ch13 is
-- Special case, the expression of these aspects is just an entity
-- that does not need any resolution, so just analyze.
- when Aspect_Input
+ when Aspect_Constructor
+ | Aspect_Input
| Aspect_Output
| Aspect_Put_Image
| Aspect_Read
@@ -11324,6 +11753,7 @@ package body Sem_Ch13 is
| Aspect_GNAT_Annotate
| Aspect_Implicit_Dereference
| Aspect_Initial_Condition
+ | Aspect_Initialize
| Aspect_Initializes
| Aspect_Max_Entry_Queue_Length
| Aspect_Max_Queue_Length
@@ -11331,8 +11761,10 @@ package body Sem_Ch13 is
| Aspect_Part_Of
| Aspect_Post
| Aspect_Postcondition
+ | Aspect_Potentially_Invalid
| Aspect_Pre
| Aspect_Precondition
+ | Aspect_Program_Exit
| Aspect_Refined_Depends
| Aspect_Refined_Global
| Aspect_Refined_Post
@@ -11359,7 +11791,7 @@ package body Sem_Ch13 is
-- the aspect_specification cause freezing (RM 13.14(7.2/5)).
if Present (Expression (ASN)) then
- Preanalyze_Spec_Expression (Expression (ASN), T);
+ Preanalyze_And_Resolve_Spec_Expression (Expression (ASN), T);
end if;
end Check_Aspect_At_Freeze_Point;
@@ -12082,18 +12514,15 @@ package body Sem_Ch13 is
if not Check_Primitive_Function (Subp, Typ) then
if Present (Ref_Node) then
- if Debug_Flag_Underscore_DD then
- Record_Default_Iterator_Not_Primitive_Error
- (Ref_Node, Subp);
- else
- Error_Msg_N ("improper function for default iterator!",
- Ref_Node);
- Error_Msg_Sloc := Sloc (Subp);
- Error_Msg_NE
- ("\\default iterator defined # "
- & "must be a local primitive or class-wide function",
- Ref_Node, Subp);
- end if;
+ Error_Msg_N
+ ("improper function for default iterator!",
+ Ref_Node,
+ GNAT0001);
+ Error_Msg_Sloc := Sloc (Subp);
+ Error_Msg_NE
+ ("\\default iterator defined # "
+ & "must be a local primitive or class-wide function",
+ Ref_Node, Subp);
end if;
return False;
@@ -13928,7 +14357,7 @@ package body Sem_Ch13 is
Next (First (Pragma_Argument_Associations (Ritem)));
begin
Push_Type (E);
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expression (Arg), Standard_Boolean);
Pop_Type (E);
end;
@@ -15786,27 +16215,36 @@ package body Sem_Ch13 is
-- anyway, no reason to be too strict about this.
if not Relaxed_RM_Semantics then
- if Debug_Flag_Underscore_DD then
-
- S := First_Subtype (T);
- if Present (Freeze_Node (S)) then
- Record_Representation_Too_Late_Error
- (Rep => N,
- Freeze => Freeze_Node (S),
- Def => S);
- else
- Error_Msg_N ("|representation item appears too late!", N);
- end if;
-
+ S := First_Subtype (T);
+ if Present (Freeze_Node (S)) then
+ Error_Msg_N
+ (Msg =>
+ "record representation cannot be specified" &
+ " after the type is frozen",
+ N => N,
+ Error_Code => GNAT0005,
+ Label =>
+ "record representation clause specified here",
+ Spans =>
+ (1 =>
+ Secondary_Labeled_Span
+ (N => Freeze_Node (S),
+ Label =>
+ "Type " & To_Name (S) &
+ " is frozen here"),
+ 2 =>
+ Secondary_Labeled_Span
+ (N => S,
+ Label =>
+ "Type " & To_Name (S) &
+ " is declared here")));
+ Error_Msg_Sloc := Sloc (Freeze_Node (S));
+ Error_Msg_N
+ ("\\move the record representation clause" &
+ " before the freeze point #",
+ N);
else
Error_Msg_N ("|representation item appears too late!", N);
-
- S := First_Subtype (T);
- if Present (Freeze_Node (S)) then
- Error_Msg_NE
- ("??no more representation items for }",
- Freeze_Node (S), S);
- end if;
end if;
end if;
end Too_Late;
@@ -16345,6 +16783,9 @@ package body Sem_Ch13 is
=>
null;
+ when Aspect_Constructor =>
+ null;
+
when Aspect_Dynamic_Predicate
| Aspect_Ghost_Predicate
| Aspect_Predicate