diff options
author | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-05 21:13:00 +0000 |
---|---|---|
committer | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2001-12-05 21:13:00 +0000 |
commit | db1260aba33fda8e6448922c02d3b4a9e02dbfdd (patch) | |
tree | 2c0ad494ce36ef9b36a04906e911710725525931 /gcc/ada | |
parent | 554f583982e359a4c0efcff0513c8b1162418290 (diff) | |
download | gcc-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/ChangeLog | 26 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 35 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_eval.adb | 20 |
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; |