* 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
+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
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
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)
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;
-- 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;
Naming.Dot_Repl_Loc);
end if;
- -- Suffixs cannot
+ -- Suffixes cannot
-- - be empty
-- - start with an alphanumeric
-- - start with an '_' followed by an alphanumeric
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
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;
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;
-- 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
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
+ Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
begin
-- 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
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;
git://gcc.gnu.org / gcc.git / commitdiff