This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Reflect ACT changes of 2001-10-23
- From: Geert Bosch <bosch at darwin dot gnat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 5 Dec 2001 16:13:38 -0500 (EST)
- Subject: [Ada] Reflect ACT changes of 2001-10-23
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.
*** sem_eval.adb 2001/09/25 15:04:44 1.292
--- sem_eval.adb 2001/10/23 00:44:49 1.293
***************
*** 1090,1095 ****
--- 1090,1096 ----
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
+ Left_Len : Int;
Right_Str : constant Node_Id := Get_String_Val (Right);
begin
***************
*** 1101,1110 ****
--- 1102,1113 ----
-- 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,1130 ****
--- 1128,1144 ----
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;
*** sem_eval.adb 2001/10/23 00:44:49 1.293
--- sem_eval.adb 2001/10/23 12:37:18 1.294
***************
*** 1045,1055 ****
-- 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);
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
--- 1045,1055 ----
-- 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);
! C_Typ : constant Entity_Id := Root_Type (Component_Type (Etype (N)));
Stat : Boolean;
Fold : Boolean;
begin
-- Concatenation is never static in Ada 83, so if Ada 83
***************
*** 1090,1096 ****
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
! Left_Len : Int;
Right_Str : constant Node_Id := Get_String_Val (Right);
begin
--- 1090,1096 ----
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
! Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
begin
*** exp_util.adb 2001/10/21 10:46:30 1.335
--- exp_util.adb 2001/10/23 00:44:51 1.336
***************
*** 125,135 ****
function Make_Literal_Range
(Loc : Source_Ptr;
! Literal_Typ : Entity_Id;
! Index_Typ : Entity_Id)
return Node_Id;
-- Produce a Range node whose bounds are:
! -- Index_Typ'first .. Index_Typ'First + Length (Literal_Typ)
-- this is used for expanding declarations like X : String := "sdfgdfg";
function New_Class_Wide_Subtype
--- 125,135 ----
function Make_Literal_Range
(Loc : Source_Ptr;
! Literal_Typ : Entity_Id)
return Node_Id;
-- Produce a Range node whose bounds are:
! -- 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,1144 ****
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Literal_Range (Loc,
! Literal_Typ => Exp_Typ,
! Index_Typ => Etype (First_Index (Unc_Type)))))));
elsif Is_Constrained (Exp_Typ)
and then not Is_Class_Wide_Type (Unc_Type)
--- 1137,1143 ----
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Literal_Range (Loc,
! Literal_Typ => Exp_Typ)))));
elsif Is_Constrained (Exp_Typ)
and then not Is_Class_Wide_Type (Unc_Type)
***************
*** 2305,2332 ****
function Make_Literal_Range
(Loc : Source_Ptr;
! Literal_Typ : Entity_Id;
! Index_Typ : Entity_Id)
return Node_Id
is
begin
return
Make_Range (Loc,
! Low_Bound =>
! Make_Attribute_Reference (Loc,
! Prefix => New_Occurrence_Of (Index_Typ, Loc),
! Attribute_Name => Name_First),
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))),
Right_Opnd => Make_Integer_Literal (Loc, 1)));
end Make_Literal_Range;
--- 2304,2330 ----
function Make_Literal_Range
(Loc : Source_Ptr;
! 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 => Lo,
High_Bound =>
Make_Op_Subtract (Loc,
Left_Opnd =>
Make_Op_Add (Loc,
! 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;
*** exp_util.adb 2001/10/23 00:44:51 1.336
--- exp_util.adb 2001/10/23 13:51:25 1.337
***************
*** 2865,2871 ****
-- regressions that are not fully understood yet.
elsif Nkind (Exp) = N_Type_Conversion
! and then not Name_Req
then
Remove_Side_Effects (Expression (Exp), Variable_Ref);
Scope_Suppress := Svg_Suppress;
--- 2865,2872 ----
-- regressions that are not fully understood yet.
elsif Nkind (Exp) = N_Type_Conversion
! 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;
*** prj-nmsc.adb 2001/10/22 21:55:07 1.30
--- prj-nmsc.adb 2001/10/23 15:48:42 1.31
***************
*** 976,982 ****
Naming.Dot_Repl_Loc);
end if;
! -- Suffixs cannot
-- - be empty
-- - start with an alphanumeric
-- - start with an '_' followed by an alphanumeric
--- 976,982 ----
Naming.Dot_Repl_Loc);
end if;
! -- Suffixes cannot
-- - be empty
-- - start with an alphanumeric
-- - start with an '_' followed by an alphanumeric
***************
*** 1983,1994 ****
declare
Kind_Name : constant String :=
! To_Lower (Name_Buffer (1 .. Name_Len));
OK : Boolean := True;
begin
-
if Kind_Name = "static" then
Data.Library_Kind := Static;
--- 1983,1993 ----
declare
Kind_Name : constant String :=
! To_Lower (Name_Buffer (1 .. Name_Len));
OK : Boolean := True;
begin
if Kind_Name = "static" then
Data.Library_Kind := Static;
*** prj-nmsc.adb 2001/10/23 15:48:42 1.31
--- prj-nmsc.adb 2001/10/23 17:52:03 1.32
***************
*** 1952,1958 ****
if not MLib.Tgt.Libraries_Are_Supported then
Error_Msg ("?libraries are not supported on this platform",
! Lib_Name.Location);
else
if Current_Verbosity = High then
--- 1952,1959 ----
if not MLib.Tgt.Libraries_Are_Supported then
Error_Msg ("?libraries are not supported on this platform",
! Lib_Name.Location);
! Data.Library := False;
else
if Current_Verbosity = High then
*** sem_ch3.adb 2001/10/21 22:08:51 1.1360
--- sem_ch3.adb 2001/10/23 20:01:24 1.1361
***************
*** 3829,3834 ****
--- 3829,3835 ----
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;