OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_eval.adb (Eval_Concatenation): If left operand is a null string, get bounds from right operand. 

* sem_eval.adb (Eval_Concatenation): If left operand is a null string,
	get bounds from right operand.

	* sem_eval.adb: Minor reformatting

	* exp_util.adb (Make_Literal_Range): use bound of literal rather
	than Index'First, its lower bound may be different from 1.

	* exp_util.adb: Undo earlier change, fixes ACVC regressions C48009B
	and C48009J

	* prj-nmsc.adb Minor reformatting

	* prj-nmsc.adb (Language_Independent_Check): Reset Library flag if
	set and libraries are not supported.

	* sem_ch3.adb (Build_Derived_Private_Type): set Public status of
	private view explicitly, so the back-end can treat as a global
	when appropriate.

From-SVN: r47692
This commit is contained in:
Geert Bosch 2001-12-05 22:13:00 +01:00
parent ef3d4d6ed8
commit f91b40db07
5 changed files with 65 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2001-12-05 Ed Schonberg <schonber@gnat.com>
* sem_eval.adb (Eval_Concatenation): If left operand is a null string,
get bounds from right operand.
* sem_eval.adb: Minor reformatting
* exp_util.adb (Make_Literal_Range): use bound of literal rather
than Index'First, its lower bound may be different from 1.
* exp_util.adb: Undo earlier change, fixes ACVC regressions C48009B
and C48009J
2001-12-05 Vincent Celier <celier@gnat.com>
* prj-nmsc.adb Minor reformatting
* prj-nmsc.adb (Language_Independent_Check): Reset Library flag if
set and libraries are not supported.
2001-12-05 Ed Schonberg <schonber@gnat.com>
* sem_ch3.adb (Build_Derived_Private_Type): set Public status of
private view explicitly, so the back-end can treat as a global
when appropriate.
2001-12-05 Ed Schonberg <schonber@gnat.com>
* sem_ch12.adb (Instantiate_Package_Body): if instance is a compilation

35
gcc/ada/exp_util.adb
View File

@ -125,11 +125,11 @@ package body Exp_Util is
function Make_Literal_Range
(Loc : Source_Ptr;
Literal_Typ : Entity_Id;
Index_Typ : Entity_Id)
Literal_Typ : Entity_Id)
return Node_Id;
-- Produce a Range node whose bounds are:
-- Index_Typ'first .. Index_Typ'First + Length (Literal_Typ)
-- Low_Bound (Literal_Type) ..
-- Low_Bound (Literal_Type) + Length (Literal_Typ) - 1
-- this is used for expanding declarations like X : String := "sdfgdfg";
function New_Class_Wide_Subtype
@ -1137,8 +1137,7 @@ package body Exp_Util is
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Literal_Range (Loc,
Literal_Typ => Exp_Typ,
Index_Typ => Etype (First_Index (Unc_Type)))))));
Literal_Typ => Exp_Typ)))));
elsif Is_Constrained (Exp_Typ)
and then not Is_Class_Wide_Type (Unc_Type)
@ -2305,28 +2304,27 @@ package body Exp_Util is
function Make_Literal_Range
(Loc : Source_Ptr;
Literal_Typ : Entity_Id;
Index_Typ : Entity_Id)
Literal_Typ : Entity_Id)
return Node_Id
is
Lo : Node_Id :=
New_Copy_Tree (String_Literal_Low_Bound (Literal_Typ));
begin
Set_Analyzed (Lo, False);
return
Make_Range (Loc,
Low_Bound =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Index_Typ, Loc),
Attribute_Name => Name_First),
Low_Bound => Lo,
High_Bound =>
Make_Op_Subtract (Loc,
Left_Opnd =>
Make_Op_Add (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Index_Typ, Loc),
Attribute_Name => Name_First),
Right_Opnd => Make_Integer_Literal (Loc,
String_Literal_Length (Literal_Typ))),
Left_Opnd => New_Copy_Tree (Lo),
Right_Opnd =>
Make_Integer_Literal (Loc,
String_Literal_Length (Literal_Typ))),
Right_Opnd => Make_Integer_Literal (Loc, 1)));
end Make_Literal_Range;
@ -2867,7 +2865,8 @@ package body Exp_Util is
-- regressions that are not fully understood yet.
elsif Nkind (Exp) = N_Type_Conversion
and then not Name_Req
and then (not Is_Elementary_Type (Underlying_Type (Exp_Type))
or else Nkind (Parent (Exp)) = N_Assignment_Statement)
then
Remove_Side_Effects (Expression (Exp), Variable_Ref);
Scope_Suppress := Svg_Suppress;

8
gcc/ada/prj-nmsc.adb
View File

@ -976,7 +976,7 @@ package body Prj.Nmsc is
Naming.Dot_Repl_Loc);
end if;
-- Suffixs cannot
-- Suffixes cannot
-- - be empty
-- - start with an alphanumeric
-- - start with an '_' followed by an alphanumeric
@ -1952,7 +1952,8 @@ package body Prj.Nmsc is
if not MLib.Tgt.Libraries_Are_Supported then
Error_Msg ("?libraries are not supported on this platform",
Lib_Name.Location);
Lib_Name.Location);
Data.Library := False;
else
if Current_Verbosity = High then
@ -1983,12 +1984,11 @@ package body Prj.Nmsc is
declare
Kind_Name : constant String :=
To_Lower (Name_Buffer (1 .. Name_Len));
To_Lower (Name_Buffer (1 .. Name_Len));
OK : Boolean := True;
begin
if Kind_Name = "static" then
Data.Library_Kind := Static;

1
gcc/ada/sem_ch3.adb
View File

@ -3827,6 +3827,7 @@ package body Sem_Ch3 is
Set_Freeze_Node (Full_Der, Empty);
Set_Depends_On_Private (Full_Der,
Has_Private_Component (Full_Der));
Set_Public_Status (Full_Der);
end if;
end if;

20
gcc/ada/sem_eval.adb
View File

@ -1045,11 +1045,11 @@ package body Sem_Eval is
-- both operands are static (RM 4.9(7), 4.9(21)).
procedure Eval_Concatenation (N : Node_Id) is
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
C_Typ : constant Entity_Id := Root_Type (Component_Type (Etype (N)));
Stat : Boolean;
Fold : Boolean;
C_Typ : constant Entity_Id := Root_Type (Component_Type (Etype (N)));
begin
-- Concatenation is never static in Ada 83, so if Ada 83
@ -1090,6 +1090,7 @@ package body Sem_Eval is
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
begin
@ -1101,10 +1102,12 @@ package body Sem_Eval is
-- case of a concatenation of a series of string literals.
if Nkind (Left_Str) = N_String_Literal then
Left_Len := String_Length (Strval (Left_Str));
Start_String (Strval (Left_Str));
else
Start_String;
Store_String_Char (Char_Literal_Value (Left_Str));
Left_Len := 1;
end if;
-- Now append the characters of the right operand
@ -1125,6 +1128,17 @@ package body Sem_Eval is
Set_Is_Static_Expression (N, Stat);
if Stat then
-- If left operand is the empty string, the result is the
-- right operand, including its bounds if anomalous.
if Left_Len = 0
and then Is_Array_Type (Etype (Right))
and then Etype (Right) /= Any_String
then
Set_Etype (N, Etype (Right));
end if;
Fold_Str (N, End_String);
end if;
end;