summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>2001-12-05 21:13:00 +0000
committerbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>2001-12-05 21:13:00 +0000
commitdb1260aba33fda8e6448922c02d3b4a9e02dbfdd (patch)
tree2c0ad494ce36ef9b36a04906e911710725525931 /gcc/ada
parent554f583982e359a4c0efcff0513c8b1162418290 (diff)
downloadgcc-db1260aba33fda8e6448922c02d3b4a9e02dbfdd.tar.gz
* 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@47692 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog26
-rw-r--r--gcc/ada/exp_util.adb35
-rw-r--r--gcc/ada/prj-nmsc.adb8
-rw-r--r--gcc/ada/sem_ch3.adb1
-rw-r--r--gcc/ada/sem_eval.adb20
5 files changed, 65 insertions, 25 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6b84b59a97f..b6a7bd54923 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,31 @@
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
unit, always replace instance node with new body, for ASIS use.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8f64f1634fb..6aeba91bf5f 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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;
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index a1f7b03fa1a..e12fe08b167 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -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;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 975fd7c4ef1..154c2347c6d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 4a26a7ebcbb..97930a6c1b5 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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;