diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 37 | ||||
| -rw-r--r-- | gcc/ada/Make-lang.in | 11 | ||||
| -rw-r--r-- | gcc/ada/a-elchha.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/a-exextr.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/s-crtl.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 6 |
9 files changed, 82 insertions, 41 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 25699d15e35..365f4ca1d7f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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> * exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index b7abcdc1aaf..cf50fb1d8f7 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -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-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 \ diff --git a/gcc/ada/a-elchha.adb b/gcc/ada/a-elchha.adb index 12699fee225..6e2da234a4b 100644 --- a/gcc/ada/a-elchha.adb +++ b/gcc/ada/a-elchha.adb @@ -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_Handler 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; diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb index 2f516b7fd1b..938f04b06e6 100644 --- a/gcc/ada/a-exextr.adb +++ b/gcc/ada/a-exextr.adb @@ -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 diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 02649747cc4..2adb5f73ba2 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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); diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 67b7a883f61..c79d6027f4b 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -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); diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index cabf61043e0..9fef16b4f24 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b1b556b9ece..93593cfaee0 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f6c4ef969c0..51971d135d3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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); |
