[multiple changes]
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 From-SVN: r74741
This commit is contained in:
parent
9684a8405a
commit
891a6e79d8
@ -1,3 +1,40 @@
|
|||||||
|
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
|
||||||
|
|
||||||
2003-12-15 Robert Dewar <dewar@gnat.com>
|
2003-12-15 Robert Dewar <dewar@gnat.com>
|
||||||
|
|
||||||
* exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default
|
* exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default
|
||||||
|
@ -1221,11 +1221,12 @@ ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
|
|||||||
|
|
||||||
ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
|
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-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/a-elchha.ads ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads \
|
||||||
ada/interfac.ads ada/system.ads ada/s-exctab.ads ada/s-except.ads \
|
ada/a-uncdea.ads ada/interfac.ads ada/system.ads ada/s-exctab.ads \
|
||||||
ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
|
ada/s-except.ads ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads \
|
||||||
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traceb.ads \
|
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
|
||||||
ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads ada/unchconv.ads
|
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/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 \
|
ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
|
||||||
|
@ -38,16 +38,15 @@
|
|||||||
-- Default version for most targets
|
-- Default version for most targets
|
||||||
|
|
||||||
procedure Ada.Exceptions.Last_Chance_Handler
|
procedure Ada.Exceptions.Last_Chance_Handler
|
||||||
(Except : Exception_Occurrence) is
|
(Except : Exception_Occurrence)
|
||||||
|
is
|
||||||
procedure Unhandled_Terminate;
|
procedure Unhandled_Terminate;
|
||||||
pragma No_Return (Unhandled_Terminate);
|
pragma No_Return (Unhandled_Terminate);
|
||||||
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
|
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
|
||||||
-- Perform system dependent shutdown code
|
-- Perform system dependent shutdown code
|
||||||
|
|
||||||
function Tailored_Exception_Information
|
function Tailored_Exception_Information
|
||||||
(X : Exception_Occurrence)
|
(X : Exception_Occurrence) return String;
|
||||||
return String;
|
|
||||||
-- Exception information to be output in the case of automatic tracing
|
-- Exception information to be output in the case of automatic tracing
|
||||||
-- requested through GNAT.Exception_Traces.
|
-- requested through GNAT.Exception_Traces.
|
||||||
--
|
--
|
||||||
@ -96,16 +95,14 @@ procedure Ada.Exceptions.Last_Chance_Handler
|
|||||||
procedure Tailored_Exception_Information
|
procedure Tailored_Exception_Information
|
||||||
(X : Exception_Occurrence;
|
(X : Exception_Occurrence;
|
||||||
Buff : in out String;
|
Buff : in out String;
|
||||||
Last : in out Integer) is
|
Last : in out Integer)
|
||||||
|
is
|
||||||
Info : String := Tailored_Exception_Information (X);
|
Info : constant String := Tailored_Exception_Information (X);
|
||||||
begin
|
begin
|
||||||
Last := Info'Last;
|
Last := Info'Last;
|
||||||
Buff (1 .. Last) := Info;
|
Buff (1 .. Last) := Info;
|
||||||
end Tailored_Exception_Information;
|
end Tailored_Exception_Information;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- First allocate & store the exception info in a buffer when
|
-- First allocate & store the exception info in a buffer when
|
||||||
-- we know it will be needed. This needs to be done before
|
-- we know it will be needed. This needs to be done before
|
||||||
@ -152,9 +149,9 @@ begin
|
|||||||
|
|
||||||
To_Stderr (Nline);
|
To_Stderr (Nline);
|
||||||
|
|
||||||
else
|
|
||||||
-- Traceback exists
|
-- Traceback exists
|
||||||
|
|
||||||
|
else
|
||||||
-- Note we can have this whole information output twice if
|
-- Note we can have this whole information output twice if
|
||||||
-- this occurrence gets reraised up to here.
|
-- this occurrence gets reraised up to here.
|
||||||
|
|
||||||
@ -165,5 +162,4 @@ begin
|
|||||||
end if;
|
end if;
|
||||||
|
|
||||||
Unhandled_Terminate;
|
Unhandled_Terminate;
|
||||||
|
|
||||||
end Ada.Exceptions.Last_Chance_Handler;
|
end Ada.Exceptions.Last_Chance_Handler;
|
||||||
|
@ -33,6 +33,11 @@
|
|||||||
|
|
||||||
with Unchecked_Conversion;
|
with Unchecked_Conversion;
|
||||||
|
|
||||||
|
pragma Warnings (Off);
|
||||||
|
with Ada.Exceptions.Last_Chance_Handler;
|
||||||
|
pragma Warnings (On);
|
||||||
|
-- Bring last chance handler into closure
|
||||||
|
|
||||||
separate (Ada.Exceptions)
|
separate (Ada.Exceptions)
|
||||||
package body Exception_Traces is
|
package body Exception_Traces is
|
||||||
|
|
||||||
|
@ -4778,13 +4778,16 @@ package body Checks is
|
|||||||
|
|
||||||
-- At the library level, we need to ensure that the
|
-- At the library level, we need to ensure that the
|
||||||
-- type of the object is elaborated before the check
|
-- 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)
|
if Is_Itype (Exptyp)
|
||||||
and then
|
and then
|
||||||
Ekind (Cunit_Entity (Current_Sem_Unit)) = E_Package
|
Ekind (Cunit_Entity (Current_Sem_Unit)) = E_Package
|
||||||
and then
|
and then
|
||||||
not In_Package_Body (Cunit_Entity (Current_Sem_Unit))
|
not In_Package_Body (Cunit_Entity (Current_Sem_Unit))
|
||||||
|
and then In_Open_Scopes (Scope (Exptyp))
|
||||||
then
|
then
|
||||||
Ref_Node := Make_Itype_Reference (Sloc (Ck_Node));
|
Ref_Node := Make_Itype_Reference (Sloc (Ck_Node));
|
||||||
Set_Itype (Ref_Node, Exptyp);
|
Set_Itype (Ref_Node, Exptyp);
|
||||||
|
@ -104,8 +104,7 @@ package body CStand is
|
|||||||
|
|
||||||
function Make_Formal
|
function Make_Formal
|
||||||
(Typ : Entity_Id;
|
(Typ : Entity_Id;
|
||||||
Formal_Name : String)
|
Formal_Name : String) return Entity_Id;
|
||||||
return Entity_Id;
|
|
||||||
-- Construct entity for subprogram formal with given name and type
|
-- Construct entity for subprogram formal with given name and type
|
||||||
|
|
||||||
function Make_Integer (V : Uint) return Node_Id;
|
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.
|
-- Build entity for standard operator with given name and type.
|
||||||
|
|
||||||
function New_Standard_Entity
|
function New_Standard_Entity
|
||||||
(New_Node_Kind : Node_Kind := N_Defining_Identifier)
|
(New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
|
||||||
return Entity_Id;
|
|
||||||
-- Builds a new entity for Standard
|
-- Builds a new entity for Standard
|
||||||
|
|
||||||
procedure Print_Standard;
|
procedure Print_Standard;
|
||||||
@ -1031,18 +1029,16 @@ package body CStand is
|
|||||||
Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
|
Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Decl :=
|
Tdef_Node := Make_Ordinary_Fixed_Point_Definition (Stloc,
|
||||||
Make_Full_Type_Declaration (Stloc,
|
|
||||||
Defining_Identifier => Standard_Duration,
|
|
||||||
Type_Definition =>
|
|
||||||
Make_Ordinary_Fixed_Point_Definition (Stloc,
|
|
||||||
Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
|
Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
|
||||||
Real_Range_Specification =>
|
Real_Range_Specification =>
|
||||||
Make_Real_Range_Specification (Stloc,
|
Make_Real_Range_Specification (Stloc,
|
||||||
Low_Bound => Make_Real_Literal (Stloc,
|
Low_Bound => Make_Real_Literal (Stloc,
|
||||||
Realval => Dlo * Delta_Val),
|
Realval => Dlo * Delta_Val),
|
||||||
High_Bound => Make_Real_Literal (Stloc,
|
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_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
|
||||||
Set_Etype (Standard_Duration, Standard_Duration);
|
Set_Etype (Standard_Duration, Standard_Duration);
|
||||||
@ -1058,7 +1054,7 @@ package body CStand is
|
|||||||
Set_Small_Value (Standard_Duration, Delta_Val);
|
Set_Small_Value (Standard_Duration, Delta_Val);
|
||||||
Set_Scalar_Range (Standard_Duration,
|
Set_Scalar_Range (Standard_Duration,
|
||||||
Real_Range_Specification
|
Real_Range_Specification
|
||||||
(Type_Definition (Decl)));
|
(Type_Definition (Parent (Standard_Duration))));
|
||||||
|
|
||||||
-- Normally it does not matter that nodes in package Standard are
|
-- Normally it does not matter that nodes in package Standard are
|
||||||
-- not marked as analyzed. The Scalar_Range of the fixed-point
|
-- not marked as analyzed. The Scalar_Range of the fixed-point
|
||||||
@ -1325,8 +1321,7 @@ package body CStand is
|
|||||||
|
|
||||||
function Make_Formal
|
function Make_Formal
|
||||||
(Typ : Entity_Id;
|
(Typ : Entity_Id;
|
||||||
Formal_Name : String)
|
Formal_Name : String) return Entity_Id
|
||||||
return Entity_Id
|
|
||||||
is
|
is
|
||||||
Formal : Entity_Id;
|
Formal : Entity_Id;
|
||||||
|
|
||||||
@ -1348,7 +1343,6 @@ package body CStand is
|
|||||||
|
|
||||||
function Make_Integer (V : Uint) return Node_Id is
|
function Make_Integer (V : Uint) return Node_Id is
|
||||||
N : constant Node_Id := Make_Integer_Literal (Stloc, V);
|
N : constant Node_Id := Make_Integer_Literal (Stloc, V);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Set_Is_Static_Expression (N);
|
Set_Is_Static_Expression (N);
|
||||||
return N;
|
return N;
|
||||||
@ -1398,8 +1392,7 @@ package body CStand is
|
|||||||
-------------------------
|
-------------------------
|
||||||
|
|
||||||
function New_Standard_Entity
|
function New_Standard_Entity
|
||||||
(New_Node_Kind : Node_Kind := N_Defining_Identifier)
|
(New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id
|
||||||
return Entity_Id
|
|
||||||
is
|
is
|
||||||
E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
|
E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
|
||||||
|
|
||||||
|
@ -36,7 +36,7 @@
|
|||||||
|
|
||||||
with System.Parameters;
|
with System.Parameters;
|
||||||
package System.CRTL is
|
package System.CRTL is
|
||||||
pragma Pure (CRTL);
|
pragma Preelaborate (CRTL);
|
||||||
|
|
||||||
subtype chars is System.Address;
|
subtype chars is System.Address;
|
||||||
-- Pointer to null-terminated array of characters
|
-- Pointer to null-terminated array of characters
|
||||||
|
@ -7715,8 +7715,8 @@ package body Sem_Ch3 is
|
|||||||
if not Error_Posted (S)
|
if not Error_Posted (S)
|
||||||
and then
|
and then
|
||||||
(Nkind (S) /= N_Range
|
(Nkind (S) /= N_Range
|
||||||
or else Base_Type (T) /= Base_Type (Etype (Low_Bound (S)))
|
or else not Covers (T, (Etype (Low_Bound (S))))
|
||||||
or else Base_Type (T) /= Base_Type (Etype (High_Bound (S))))
|
or else not Covers (T, (Etype (High_Bound (S)))))
|
||||||
then
|
then
|
||||||
if Base_Type (T) /= Any_Type
|
if Base_Type (T) /= Any_Type
|
||||||
and then Etype (Low_Bound (S)) /= Any_Type
|
and then Etype (Low_Bound (S)) /= Any_Type
|
||||||
|
@ -6207,6 +6207,12 @@ package body Sem_Res is
|
|||||||
Error_Msg_N ("\as Duration, and will lose precision?", Rop);
|
Error_Msg_N ("\as Duration, and will lose precision?", Rop);
|
||||||
end if;
|
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
|
else
|
||||||
Error_Msg_N ("invalid context for mixed mode operation", N);
|
Error_Msg_N ("invalid context for mixed mode operation", N);
|
||||||
Set_Etype (Operand, Any_Type);
|
Set_Etype (Operand, Any_Type);
|
||||||
|
Loading…
Reference in New Issue
Block a user