This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
committed: Ada updates
- From: Arnaud Charlet <charlet at ACT-Europe dot FR>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 17 Dec 2003 14:39:23 +0100
- Subject: committed: Ada updates
Tested on x86-linux
--
2003-12-17 Ed Falis <falis@gnat.com>
* a-elchha.adb (Tailored_Exception_Information): made Info constant to
eliminate warning.
* a-exextr.adb: Add context clause for
Ada.Exceptions.Last_Chance_Handler.
2003-12-17 Sergey Rybin <rybin@act-europe.fr>
* cstand.adb (Create_Standard): Change the way how the declaration of
the Duration type is created (making it the same way as it is for all
the other standard types).
2003-12-17 Robert Dewar <dewar@gnat.com>
* s-crtl.ads: Fix header format
Change Pure to Preelaborate
2003-12-17 Ed Schonberg <schonberg@gnat.com>
* checks.adb (Selected_Length_Checks): Generate an Itype reference for
the expression type only if it is declared in the current unit.
* sem_ch3.adb (Constrain_Index): Handle properly a range whose bounds
are universal and already analyzed, as can occur in constrained
subcomponents that depend on discriminants, when one constraint is a
subtype mark.
* sem_res.adb (Resolve_Type_Conversion): Any arithmetic expression of
type Any_Fixed is legal as the argument of a conversion, if only one
fixed-point type is in context.
2003-12-17 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
--
Index: a-elchha.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-elchha.adb,v
retrieving revision 1.1
diff -u -p -r1.1 a-elchha.adb
--- a-elchha.adb 5 Dec 2003 10:24:04 -0000 1.1
+++ a-elchha.adb 17 Dec 2003 11:19:44 -0000
@@ -38,16 +38,15 @@
-- Default version for most targets
procedure Ada.Exceptions.Last_Chance_Handler
- (Except : Exception_Occurrence) is
-
+ (Except : Exception_Occurrence)
+is
procedure Unhandled_Terminate;
pragma No_Return (Unhandled_Terminate);
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
-- Perform system dependent shutdown code
function Tailored_Exception_Information
- (X : Exception_Occurrence)
- return String;
+ (X : Exception_Occurrence) return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
--
@@ -96,16 +95,14 @@ procedure Ada.Exceptions.Last_Chance_Han
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
- Last : in out Integer) is
-
- Info : String := Tailored_Exception_Information (X);
+ Last : in out Integer)
+ is
+ Info : constant String := Tailored_Exception_Information (X);
begin
Last := Info'Last;
Buff (1 .. Last) := Info;
end Tailored_Exception_Information;
-
-
begin
-- First allocate & store the exception info in a buffer when
-- we know it will be needed. This needs to be done before
@@ -152,9 +149,9 @@ begin
To_Stderr (Nline);
- else
- -- Traceback exists
+ -- Traceback exists
+ else
-- Note we can have this whole information output twice if
-- this occurrence gets reraised up to here.
@@ -165,5 +162,4 @@ begin
end if;
Unhandled_Terminate;
-
end Ada.Exceptions.Last_Chance_Handler;
Index: a-exextr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-exextr.adb,v
retrieving revision 1.2
diff -u -p -r1.2 a-exextr.adb
--- a-exextr.adb 5 Dec 2003 10:24:04 -0000 1.2
+++ a-exextr.adb 17 Dec 2003 11:19:44 -0000
@@ -33,6 +33,11 @@
with Unchecked_Conversion;
+pragma Warnings (Off);
+with Ada.Exceptions.Last_Chance_Handler;
+pragma Warnings (On);
+-- Bring last chance handler into closure
+
separate (Ada.Exceptions)
package body Exception_Traces is
Index: checks.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/checks.adb,v
retrieving revision 1.13
diff -u -p -r1.13 checks.adb
--- checks.adb 14 Nov 2003 10:24:42 -0000 1.13
+++ checks.adb 17 Dec 2003 11:19:44 -0000
@@ -4778,13 +4778,16 @@ package body Checks is
-- At the library level, we need to ensure that the
-- type of the object is elaborated before the check
- -- itself is emitted.
+ -- itself is emitted. This is only done if the object
+ -- is in the current compilation unit, otherwise the
+ -- type is frozen and elaborated in its unit.
if Is_Itype (Exptyp)
and then
Ekind (Cunit_Entity (Current_Sem_Unit)) = E_Package
and then
not In_Package_Body (Cunit_Entity (Current_Sem_Unit))
+ and then In_Open_Scopes (Scope (Exptyp))
then
Ref_Node := Make_Itype_Reference (Sloc (Ck_Node));
Set_Itype (Ref_Node, Exptyp);
Index: cstand.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/cstand.adb,v
retrieving revision 1.12
diff -u -p -r1.12 cstand.adb
--- cstand.adb 21 Nov 2003 10:46:37 -0000 1.12
+++ cstand.adb 17 Dec 2003 11:19:44 -0000
@@ -104,8 +104,7 @@ package body CStand is
function Make_Formal
(Typ : Entity_Id;
- Formal_Name : String)
- return Entity_Id;
+ Formal_Name : String) return Entity_Id;
-- Construct entity for subprogram formal with given name and type
function Make_Integer (V : Uint) return Node_Id;
@@ -118,8 +117,7 @@ package body CStand is
-- Build entity for standard operator with given name and type.
function New_Standard_Entity
- (New_Node_Kind : Node_Kind := N_Defining_Identifier)
- return Entity_Id;
+ (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
-- Builds a new entity for Standard
procedure Print_Standard;
@@ -1009,9 +1007,9 @@ package body CStand is
-- delta and size values depend on the mode set in system.ads.
Build_Duration : declare
- Dlo : Uint;
- Dhi : Uint;
- Delta_Val : Ureal;
+ Dlo : Uint;
+ Dhi : Uint;
+ Delta_Val : Ureal;
begin
-- In 32 bit mode, the size is 32 bits, and the delta and
@@ -1031,18 +1029,16 @@ package body CStand is
Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
end if;
- Decl :=
- Make_Full_Type_Declaration (Stloc,
- Defining_Identifier => Standard_Duration,
- Type_Definition =>
- Make_Ordinary_Fixed_Point_Definition (Stloc,
+ Tdef_Node := Make_Ordinary_Fixed_Point_Definition (Stloc,
Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
Real_Range_Specification =>
Make_Real_Range_Specification (Stloc,
Low_Bound => Make_Real_Literal (Stloc,
Realval => Dlo * Delta_Val),
High_Bound => Make_Real_Literal (Stloc,
- Realval => Dhi * Delta_Val))));
+ Realval => Dhi * Delta_Val)));
+
+ Set_Type_Definition (Parent (Standard_Duration), Tdef_Node);
Set_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
Set_Etype (Standard_Duration, Standard_Duration);
@@ -1058,7 +1054,7 @@ package body CStand is
Set_Small_Value (Standard_Duration, Delta_Val);
Set_Scalar_Range (Standard_Duration,
Real_Range_Specification
- (Type_Definition (Decl)));
+ (Type_Definition (Parent (Standard_Duration))));
-- Normally it does not matter that nodes in package Standard are
-- not marked as analyzed. The Scalar_Range of the fixed-point
@@ -1325,8 +1321,7 @@ package body CStand is
function Make_Formal
(Typ : Entity_Id;
- Formal_Name : String)
- return Entity_Id
+ Formal_Name : String) return Entity_Id
is
Formal : Entity_Id;
@@ -1348,7 +1343,6 @@ package body CStand is
function Make_Integer (V : Uint) return Node_Id is
N : constant Node_Id := Make_Integer_Literal (Stloc, V);
-
begin
Set_Is_Static_Expression (N);
return N;
@@ -1398,8 +1392,7 @@ package body CStand is
-------------------------
function New_Standard_Entity
- (New_Node_Kind : Node_Kind := N_Defining_Identifier)
- return Entity_Id
+ (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id
is
E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
Index: s-crtl.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-crtl.ads,v
retrieving revision 1.1
diff -u -p -r1.1 s-crtl.ads
--- s-crtl.ads 15 Dec 2003 11:51:01 -0000 1.1
+++ s-crtl.ads 17 Dec 2003 11:19:44 -0000
@@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
--- S Y S T E M . C R T L --
+-- S Y S T E M . C R T L --
-- --
-- S p e c --
-- --
@@ -36,7 +36,7 @@
with System.Parameters;
package System.CRTL is
- pragma Pure (CRTL);
+pragma Preelaborate (CRTL);
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
Index: sem_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch3.adb,v
retrieving revision 1.26
diff -u -p -r1.26 sem_ch3.adb
--- sem_ch3.adb 11 Dec 2003 16:21:39 -0000 1.26
+++ sem_ch3.adb 17 Dec 2003 11:19:45 -0000
@@ -7715,8 +7715,8 @@ package body Sem_Ch3 is
if not Error_Posted (S)
and then
(Nkind (S) /= N_Range
- or else Base_Type (T) /= Base_Type (Etype (Low_Bound (S)))
- or else Base_Type (T) /= Base_Type (Etype (High_Bound (S))))
+ or else not Covers (T, (Etype (Low_Bound (S))))
+ or else not Covers (T, (Etype (High_Bound (S)))))
then
if Base_Type (T) /= Any_Type
and then Etype (Low_Bound (S)) /= Any_Type
Index: sem_res.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_res.adb,v
retrieving revision 1.15
diff -u -p -r1.15 sem_res.adb
--- sem_res.adb 11 Dec 2003 16:21:39 -0000 1.15
+++ sem_res.adb 17 Dec 2003 11:19:45 -0000
@@ -6207,6 +6207,12 @@ package body Sem_Res is
Error_Msg_N ("\as Duration, and will lose precision?", Rop);
end if;
+ elsif Is_Numeric_Type (Typ)
+ and then Nkind (Operand) in N_Op
+ and then Unique_Fixed_Point_Type (N) /= Any_Type
+ then
+ Set_Etype (Operand, Standard_Duration);
+
else
Error_Msg_N ("invalid context for mixed mode operation", N);
Set_Etype (Operand, Any_Type);
Index: Make-lang.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Make-lang.in,v
retrieving revision 1.63
diff -u -p -r1.63 Make-lang.in
--- Make-lang.in 15 Dec 2003 11:51:01 -0000 1.63
+++ Make-lang.in 17 Dec 2003 11:19:45 -0000
@@ -1221,11 +1221,12 @@ ada/a-elchha.o : ada/ada.ads ada/a-excep
ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
- ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads ada/a-uncdea.ads \
- ada/interfac.ads ada/system.ads ada/s-exctab.ads ada/s-except.ads \
- ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
- ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traceb.ads \
- ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads ada/unchconv.ads
+ ada/a-elchha.ads ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads \
+ ada/a-uncdea.ads ada/interfac.ads ada/system.ads ada/s-exctab.ads \
+ ada/s-except.ads ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads \
+ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+ ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads \
+ ada/unchconv.ads
ada/a-ioexce.o : ada/ada.ads ada/a-except.ads ada/a-ioexce.ads \
ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \