2003-12-17 Ed Falis <falis@gnat.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 17 Dec 2003 13:37:04 +0000 (13:37 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 17 Dec 2003 13:37:04 +0000 (13:37 +0000)
* 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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@74741 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/Make-lang.in
gcc/ada/a-elchha.adb
gcc/ada/a-exextr.adb
gcc/ada/checks.adb
gcc/ada/cstand.adb
gcc/ada/s-crtl.ads
gcc/ada/sem_ch3.adb
gcc/ada/sem_res.adb

index 25699d1..365f4ca 100644 (file)
@@ -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
index b7abcdc..cf50fb1 100644 (file)
@@ -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 \
index 12699fe..6e2da23 100644 (file)
 --  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;
index 2f516b7..938f04b 100644 (file)
 
 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 0264974..2adb5f7 100644 (file)
@@ -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 67b7a88..c79d602 100644 (file)
@@ -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 cabf610..9fef16b 100644 (file)
@@ -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 b1b556b..93593cf 100644 (file)
@@ -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 f6c4ef9..51971d1 100644 (file)
@@ -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);