Commit 24657705 by Hristian Kirtchev Committed by Arnaud Charlet

sem_ch4.adb: Minor code and comment reformatting.

2007-10-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch4.adb: Minor code and comment reformatting.
	(Analyze_Allocator): When the designated type of an unconstrained
	allocator is a record with unknown discriminants or an array with
	unknown range bounds, emit a detailed error message depending on the
	compilation mode and whether the designated type is limited.

From-SVN: r129334
parent 0501956d
...@@ -424,8 +424,8 @@ package body Sem_Ch4 is ...@@ -424,8 +424,8 @@ package body Sem_Ch4 is
then then
Error_Msg_N ("constraint not allowed here", E); Error_Msg_N ("constraint not allowed here", E);
if Nkind (Constraint (E)) if Nkind (Constraint (E)) =
= N_Index_Or_Discriminant_Constraint N_Index_Or_Discriminant_Constraint
then then
Error_Msg_N Error_Msg_N
("\if qualified expression was meant, " & ("\if qualified expression was meant, " &
...@@ -499,7 +499,7 @@ package body Sem_Ch4 is ...@@ -499,7 +499,7 @@ package body Sem_Ch4 is
-- Check for missing initialization. Skip this check if we already -- Check for missing initialization. Skip this check if we already
-- had errors on analyzing the allocator, since in that case these -- had errors on analyzing the allocator, since in that case these
-- are probably cascaded errors -- are probably cascaded errors.
if Is_Indefinite_Subtype (Type_Id) if Is_Indefinite_Subtype (Type_Id)
and then Serious_Errors_Detected = Sav_Errs and then Serious_Errors_Detected = Sav_Errs
...@@ -508,8 +508,44 @@ package body Sem_Ch4 is ...@@ -508,8 +508,44 @@ package body Sem_Ch4 is
Error_Msg_N Error_Msg_N
("initialization required in class-wide allocation", N); ("initialization required in class-wide allocation", N);
else else
Error_Msg_N if Ada_Version < Ada_05
("initialization required in unconstrained allocation", N); and then Is_Limited_Type (Type_Id)
then
Error_Msg_N ("unconstrained allocation not allowed", N);
if Is_Array_Type (Type_Id) then
Error_Msg_N
("\constraint with array bounds required", N);
elsif Has_Unknown_Discriminants (Type_Id) then
null;
else pragma Assert (Has_Discriminants (Type_Id));
Error_Msg_N
("\constraint with discriminant values required", N);
end if;
-- Limited Ada 2005 and general non-limited case
else
Error_Msg_N
("uninitialized unconstrained allocation not allowed",
N);
if Is_Array_Type (Type_Id) then
Error_Msg_N
("\qualified expression or constraint with " &
"array bounds required", N);
elsif Has_Unknown_Discriminants (Type_Id) then
Error_Msg_N ("\qualified expression required", N);
else pragma Assert (Has_Discriminants (Type_Id));
Error_Msg_N
("\qualified expression or constraint with " &
"discriminant values required", N);
end if;
end if;
end if; end if;
end if; end if;
end; end;
...@@ -3908,11 +3944,13 @@ package body Sem_Ch4 is ...@@ -3908,11 +3944,13 @@ package body Sem_Ch4 is
Actual : Node_Id; Actual : Node_Id;
X : Interp_Index; X : Interp_Index;
It : Interp; It : Interp;
Success : Boolean;
Err_Mode : Boolean; Err_Mode : Boolean;
New_Nam : Node_Id; New_Nam : Node_Id;
Void_Interp_Seen : Boolean := False; Void_Interp_Seen : Boolean := False;
Success : Boolean;
pragma Warnings (Off, Boolean);
begin begin
if Ada_Version >= Ada_05 then if Ada_Version >= Ada_05 then
Actual := First_Actual (N); Actual := First_Actual (N);
...@@ -5148,9 +5186,11 @@ package body Sem_Ch4 is ...@@ -5148,9 +5186,11 @@ package body Sem_Ch4 is
Nam : Entity_Id; Nam : Entity_Id;
Typ : Entity_Id) return Boolean Typ : Entity_Id) return Boolean
is is
Actual : Node_Id; Actual : Node_Id;
Formal : Entity_Id; Formal : Entity_Id;
Call_OK : Boolean; Call_OK : Boolean;
pragma Warnings (Off, Call_OK);
begin begin
Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK); Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK);
......
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