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>
* 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
in no run time mode.
......
gcc/ada/sem_ch3.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.1354 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -1147,6 +1147,17 @@ package body Sem_Ch3 is
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);
-- Verify that the expression is static and numeric. If
......@@ -2302,8 +2313,14 @@ package body Sem_Ch3 is
begin
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;
------------------------------
......@@ -12062,42 +12079,53 @@ package body Sem_Ch3 is
Lo := Low_Bound (Def);
Hi := High_Bound (Def);
Analyze_And_Resolve (Lo, Any_Integer);
Analyze_And_Resolve (Hi, Any_Integer);
Check_Bound (Lo);
Check_Bound (Hi);
-- Arbitrarily use Integer as the type if either bound had an error
if Errs then
Hi := Type_High_Bound (Standard_Long_Long_Integer);
Lo := Type_Low_Bound (Standard_Long_Long_Integer);
end if;
if Hi = Error or else Lo = Error then
Base_Typ := Any_Integer;
Set_Error_Posted (T, True);
-- Find type to derive from
-- Here both bounds are OK expressions
Lo_Val := Expr_Value (Lo);
Hi_Val := Expr_Value (Hi);
else
Analyze_And_Resolve (Lo, Any_Integer);
Analyze_And_Resolve (Hi, Any_Integer);
if Can_Derive_From (Standard_Short_Short_Integer) then
Base_Typ := Base_Type (Standard_Short_Short_Integer);
Check_Bound (Lo);
Check_Bound (Hi);
elsif Can_Derive_From (Standard_Short_Integer) then
Base_Typ := Base_Type (Standard_Short_Integer);
if Errs then
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
Base_Typ := Base_Type (Standard_Integer);
-- Find type to derive from
elsif Can_Derive_From (Standard_Long_Integer) then
Base_Typ := Base_Type (Standard_Long_Integer);
Lo_Val := Expr_Value (Lo);
Hi_Val := Expr_Value (Hi);
elsif Can_Derive_From (Standard_Long_Long_Integer) then
Base_Typ := Base_Type (Standard_Long_Long_Integer);
if Can_Derive_From (Standard_Short_Short_Integer) then
Base_Typ := Base_Type (Standard_Short_Short_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);
elsif Can_Derive_From (Standard_Short_Integer) then
Base_Typ := Base_Type (Standard_Short_Integer);
elsif Can_Derive_From (Standard_Integer) then
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;
-- Complete both implicit base and declared first subtype entities
......
gcc/ada/sem_util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.541 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -2169,6 +2169,7 @@ package body Sem_Util is
procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id) is
Kind : constant Node_Kind := Nkind (N);
R : Node_Id;
begin
if Kind = N_Range then
......@@ -2176,8 +2177,17 @@ package body Sem_Util is
H := High_Bound (N);
elsif Kind = N_Subtype_Indication then
L := Low_Bound (Range_Expression (Constraint (N)));
H := High_Bound (Range_Expression (Constraint (N)));
R := 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
if Error_Posted (Scalar_Range (Entity (N))) then
......@@ -2198,7 +2208,6 @@ package body Sem_Util is
L := N;
H := N;
end if;
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