Commit 2a1b208c by Robert Dewar Committed by Arnaud Charlet

sem_ch4.adb (Analyze_Quantified_Expression): Add comment.

2012-03-15  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb (Analyze_Quantified_Expression): Add comment.
	* sem_prag.adb: Minor comment additions.
	* sem_attr.adb (Check_First_Last_Valid): Make sure prefix type
	is frozen.

From-SVN: r185420
parent ce6002ec
2012-03-15 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb (Analyze_Quantified_Expression): Add comment.
* sem_prag.adb: Minor comment additions.
* sem_attr.adb (Check_First_Last_Valid): Make sure prefix type
is frozen.
2012-03-15 Vincent Pucci <pucci@adacore.com> 2012-03-15 Vincent Pucci <pucci@adacore.com>
* sem_ch4.adb (Analyze_Quantified_Expression): * sem_ch4.adb (Analyze_Quantified_Expression):
......
...@@ -1273,9 +1273,12 @@ package body Sem_Attr is ...@@ -1273,9 +1273,12 @@ package body Sem_Attr is
Check_Ada_2012_Attribute; Check_Ada_2012_Attribute;
Check_Discrete_Type; Check_Discrete_Type;
if not Is_Static_Subtype (P_Type) then -- Freeze the subtype now, so that the following test for predicates
Error_Attr_P ("prefix of % attribute must be a static subtype"); -- works (we set the predicates stuff up at freeze time)
end if;
Insert_Actions (N, Freeze_Entity (P_Type, P));
-- Now test for dynamic predicate
if Has_Predicates (P_Type) if Has_Predicates (P_Type)
and then No (Static_Predicate (P_Type)) and then No (Static_Predicate (P_Type))
...@@ -1284,6 +1287,14 @@ package body Sem_Attr is ...@@ -1284,6 +1287,14 @@ package body Sem_Attr is
("prefix of % attribute may not have dynamic predicate"); ("prefix of % attribute may not have dynamic predicate");
end if; end if;
-- Check non-static subtype
if not Is_Static_Subtype (P_Type) then
Error_Attr_P ("prefix of % attribute must be a static subtype");
end if;
-- Test case for no values
if Expr_Value (Type_Low_Bound (P_Type)) > if Expr_Value (Type_Low_Bound (P_Type)) >
Expr_Value (Type_High_Bound (P_Type)) Expr_Value (Type_High_Bound (P_Type))
or else (Has_Predicates (P_Type) or else (Has_Predicates (P_Type)
......
...@@ -3449,6 +3449,12 @@ package body Sem_Ch4 is ...@@ -3449,6 +3449,12 @@ package body Sem_Ch4 is
-- quantified expression, only a preanalysis of the condition needs -- quantified expression, only a preanalysis of the condition needs
-- to be done. -- to be done.
-- This is weird and irregular code for several reasons. First, doing
-- an Analyze with no Resolve is very suspicious, how can this be
-- right for the overloaded case ??? Second, doing two calls to
-- analyze on the same node is peculiar ??? Why can't we use the
-- normal Preanalyze calls here ???
Expander_Mode_Save_And_Set (False); Expander_Mode_Save_And_Set (False);
Analyze (Condition (N)); Analyze (Condition (N));
Expander_Mode_Restore; Expander_Mode_Restore;
......
...@@ -696,7 +696,8 @@ package body Sem_Prag is ...@@ -696,7 +696,8 @@ package body Sem_Prag is
pragma No_Return (Error_Pragma); pragma No_Return (Error_Pragma);
-- Outputs error message for current pragma. The message contains a % -- Outputs error message for current pragma. The message contains a %
-- that will be replaced with the pragma name, and the flag is placed -- that will be replaced with the pragma name, and the flag is placed
-- on the pragma itself. Pragma_Exit is then raised. -- on the pragma itself. Pragma_Exit is then raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id); procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg); pragma No_Return (Error_Pragma_Arg);
...@@ -707,7 +708,8 @@ package body Sem_Prag is ...@@ -707,7 +708,8 @@ package body Sem_Prag is
-- in which case the flag is placed directly on the expression. The -- in which case the flag is placed directly on the expression. The
-- message is placed using Error_Msg_N, so the message may also contain -- message is placed using Error_Msg_N, so the message may also contain
-- an & insertion character which will reference the given Arg value. -- an & insertion character which will reference the given Arg value.
-- After placing the message, Pragma_Exit is raised. -- After placing the message, Pragma_Exit is raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id); procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg); pragma No_Return (Error_Pragma_Arg);
...@@ -723,14 +725,16 @@ package body Sem_Prag is ...@@ -723,14 +725,16 @@ package body Sem_Prag is
-- on the identifier. The message is placed using Error_Msg_N so -- on the identifier. The message is placed using Error_Msg_N so
-- the message may also contain an & insertion character which will -- the message may also contain an & insertion character which will
-- reference the identifier. After placing the message, Pragma_Exit -- reference the identifier. After placing the message, Pragma_Exit
-- is raised. -- is raised. Note: this routine calls Fix_Error (see spec of that
-- function for details).
procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id); procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id);
pragma No_Return (Error_Pragma_Ref); pragma No_Return (Error_Pragma_Ref);
-- Outputs error message for current pragma. The message may contain -- Outputs error message for current pragma. The message may contain
-- a % that will be replaced with the pragma name. The parameter Ref -- a % that will be replaced with the pragma name. The parameter Ref
-- must be an entity whose name can be referenced by & and sloc by #. -- must be an entity whose name can be referenced by & and sloc by #.
-- After placing the message, Pragma_Exit is raised. -- After placing the message, Pragma_Exit is raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
function Find_Lib_Unit_Name return Entity_Id; function Find_Lib_Unit_Name return Entity_Id;
-- Used for a library unit pragma to find the entity to which the -- Used for a library unit pragma to find the entity to which the
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment