Skip to content

R
riscv-gcc-1
Commit ce9e9122 by Robert Dewar Committed by Geert Bosch
Options

* sem_ch3.adb: 

	(Analyze_Number_Declaration): Handle error expression.
	(Signed_Integer_Type_Declaration): Handle error bound.
	(Analyze_Subtype_Indication): Handle error range.

	* sem_util.adb (Get_Index_Bounds): Check for Error.

From-SVN: r46508
parent e12fbc9e
Showing with 79 additions and 33 deletions
gcc/ada/ChangeLog
2001-10-25 Robert Dewar <dewar@gnat.com> 2001-10-25 Robert Dewar <dewar@gnat.com>
* sem_ch3.adb:
(Analyze_Number_Declaration): Handle error expression.
(Signed_Integer_Type_Declaration): Handle error bound.
(Analyze_Subtype_Indication): Handle error range.
* sem_util.adb (Get_Index_Bounds): Check for Error.
2001-10-25 Robert Dewar <dewar@gnat.com>
* restrict.adb (Set_No_Run_Time_Mode): Set Discard_Names as default * restrict.adb (Set_No_Run_Time_Mode): Set Discard_Names as default
in no run time mode. in no run time mode.
......
gcc/ada/sem_ch3.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.1354 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- -- -- --
...@@ -1147,6 +1147,17 @@ package body Sem_Ch3 is ...@@ -1147,6 +1147,17 @@ package body Sem_Ch3 is
Set_Is_Pure (Id, Is_Pure (Current_Scope)); Set_Is_Pure (Id, Is_Pure (Current_Scope));
-- Process expression, replacing error by integer zero, to avoid
-- cascaded errors or aborts further along in the processing
-- Replace Error by integer zero, which seems least likely to
-- cause cascaded errors.
if E = Error then
Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0));
Set_Error_Posted (E);
end if;
Analyze (E); Analyze (E);
-- Verify that the expression is static and numeric. If -- Verify that the expression is static and numeric. If
...@@ -2302,8 +2313,14 @@ package body Sem_Ch3 is ...@@ -2302,8 +2313,14 @@ package body Sem_Ch3 is
begin begin
Analyze (T); Analyze (T);
Analyze (R);
Set_Etype (N, Etype (R)); if R /= Error then
Analyze (R);
Set_Etype (N, Etype (R));
else
Set_Error_Posted (R);
Set_Error_Posted (T);
end if;
end Analyze_Subtype_Indication; end Analyze_Subtype_Indication;
------------------------------ ------------------------------
...@@ -12062,42 +12079,53 @@ package body Sem_Ch3 is ...@@ -12062,42 +12079,53 @@ package body Sem_Ch3 is
Lo := Low_Bound (Def); Lo := Low_Bound (Def);
Hi := High_Bound (Def); Hi := High_Bound (Def);
Analyze_And_Resolve (Lo, Any_Integer);
Analyze_And_Resolve (Hi, Any_Integer);
Check_Bound (Lo); -- Arbitrarily use Integer as the type if either bound had an error
Check_Bound (Hi);
if Errs then if Hi = Error or else Lo = Error then
Hi := Type_High_Bound (Standard_Long_Long_Integer); Base_Typ := Any_Integer;
Lo := Type_Low_Bound (Standard_Long_Long_Integer); Set_Error_Posted (T, True);
end if;
-- Find type to derive from -- Here both bounds are OK expressions
Lo_Val := Expr_Value (Lo); else
Hi_Val := Expr_Value (Hi); Analyze_And_Resolve (Lo, Any_Integer);
Analyze_And_Resolve (Hi, Any_Integer);
if Can_Derive_From (Standard_Short_Short_Integer) then Check_Bound (Lo);
Base_Typ := Base_Type (Standard_Short_Short_Integer); Check_Bound (Hi);
elsif Can_Derive_From (Standard_Short_Integer) then if Errs then
Base_Typ := Base_Type (Standard_Short_Integer); Hi := Type_High_Bound (Standard_Long_Long_Integer);
Lo := Type_Low_Bound (Standard_Long_Long_Integer);
end if;
elsif Can_Derive_From (Standard_Integer) then -- Find type to derive from
Base_Typ := Base_Type (Standard_Integer);
elsif Can_Derive_From (Standard_Long_Integer) then Lo_Val := Expr_Value (Lo);
Base_Typ := Base_Type (Standard_Long_Integer); Hi_Val := Expr_Value (Hi);
elsif Can_Derive_From (Standard_Long_Long_Integer) then if Can_Derive_From (Standard_Short_Short_Integer) then
Base_Typ := Base_Type (Standard_Long_Long_Integer); Base_Typ := Base_Type (Standard_Short_Short_Integer);
else elsif Can_Derive_From (Standard_Short_Integer) then
Base_Typ := Base_Type (Standard_Long_Long_Integer); Base_Typ := Base_Type (Standard_Short_Integer);
Error_Msg_N ("integer type definition bounds out of range", Def);
Hi := Type_High_Bound (Standard_Long_Long_Integer); elsif Can_Derive_From (Standard_Integer) then
Lo := Type_Low_Bound (Standard_Long_Long_Integer); Base_Typ := Base_Type (Standard_Integer);
elsif Can_Derive_From (Standard_Long_Integer) then
Base_Typ := Base_Type (Standard_Long_Integer);
elsif Can_Derive_From (Standard_Long_Long_Integer) then
Base_Typ := Base_Type (Standard_Long_Long_Integer);
else
Base_Typ := Base_Type (Standard_Long_Long_Integer);
Error_Msg_N ("integer type definition bounds out of range", Def);
Hi := Type_High_Bound (Standard_Long_Long_Integer);
Lo := Type_Low_Bound (Standard_Long_Long_Integer);
end if;
end if; end if;
-- Complete both implicit base and declared first subtype entities -- Complete both implicit base and declared first subtype entities
......
gcc/ada/sem_util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.541 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- -- -- --
...@@ -2169,6 +2169,7 @@ package body Sem_Util is ...@@ -2169,6 +2169,7 @@ package body Sem_Util is
procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id) is procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id) is
Kind : constant Node_Kind := Nkind (N); Kind : constant Node_Kind := Nkind (N);
R : Node_Id;
begin begin
if Kind = N_Range then if Kind = N_Range then
...@@ -2176,8 +2177,17 @@ package body Sem_Util is ...@@ -2176,8 +2177,17 @@ package body Sem_Util is
H := High_Bound (N); H := High_Bound (N);
elsif Kind = N_Subtype_Indication then elsif Kind = N_Subtype_Indication then
L := Low_Bound (Range_Expression (Constraint (N))); R := Range_Expression (Constraint (N));
H := High_Bound (Range_Expression (Constraint (N)));
if R = Error then
L := Error;
H := Error;
return;
else
L := Low_Bound (Range_Expression (Constraint (N)));
H := High_Bound (Range_Expression (Constraint (N)));
end if;
elsif Is_Entity_Name (N) and then Is_Type (Entity (N)) then elsif Is_Entity_Name (N) and then Is_Type (Entity (N)) then
if Error_Posted (Scalar_Range (Entity (N))) then if Error_Posted (Scalar_Range (Entity (N))) then
...@@ -2198,7 +2208,6 @@ package body Sem_Util is ...@@ -2198,7 +2208,6 @@ package body Sem_Util is
L := N; L := N;
H := N; H := N;
end if; end if;
end Get_Index_Bounds; end Get_Index_Bounds;
------------------------ ------------------------
......
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