OSDN Git Service

* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
authorbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 11 Dec 2001 23:01:00 +0000 (23:01 +0000)
committerbosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 11 Dec 2001 23:01:00 +0000 (23:01 +0000)
sem_attr.

* sem_attr.adb: Simplify previous fix for Address.
(Set_Bounds): If prefix is a non-frozen fixed-point type, freeze now,
to avoid anomalies where the bound of the type appears to raise
constraint error.

* lib-xref.adb (Output_Refs): Make sure pointers are always properly
handled.

* sem_ch12.adb (Analyze_Subprogram_Instantiation): Check for a
renamed unit before checking for recursive instantiations.

* prj.ads: Add comments for some of the fields.

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

gcc/ada/ChangeLog
gcc/ada/freeze.adb
gcc/ada/lib-xref.adb
gcc/ada/prj.ads
gcc/ada/sem_attr.adb
gcc/ada/sem_ch12.adb

index 4424fc4..5f65705 100644 (file)
@@ -1,3 +1,27 @@
+2001-12-11  Ed Schonberg <schonber@gnat.com>
+
+       * freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
+       sem_attr.
+       
+       * sem_attr.adb: Simplify previous fix for Address.
+       (Set_Bounds): If prefix is a non-frozen fixed-point type, freeze now, 
+       to avoid anomalies where the bound of the type appears to raise 
+       constraint error.
+
+2001-12-11  Robert Dewar <dewar@gnat.com>
+
+       * lib-xref.adb (Output_Refs): Make sure pointers are always properly 
+       handled.
+       
+2001-12-11  Ed Schonberg <schonber@gnat.com>
+
+       * sem_ch12.adb (Analyze_Subprogram_Instantiation): Check for a 
+       renamed unit before checking for recursive instantiations.
+       
+2001-12-11  Emmanuel Briot <briot@gnat.com>
+
+       * prj.ads: Add comments for some of the fields.
+
 2001-12-11  Robert Dewar <dewar@gnat.com>
 
        * lib-xref.adb (Output_Refs): Don't output type references outside 
@@ -23,7 +47,7 @@
        
        * Makefile.in: Added g-diopit.o to GNATRTL_NONTASKING_OBJS
        
-2001-12-11  Richard Kenner <dewar@gnat.com>
+2001-12-11  Robert Dewar <dewar@gnat.com>
 
        * sem_attr.adb: Minor reformatting
 
index 6f4c4c7..55a9810 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.281 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
 --                                                                          --
@@ -105,11 +105,6 @@ package body Freeze is
    --  that if a foreign convention is specified, and no specific size
    --  is given, then the size must be at least Integer'Size.
 
-   procedure Freeze_Fixed_Point_Type (Typ : Entity_Id);
-   --  Freeze fixed point type. For fixed-point types, we have to defer
-   --  setting the size and bounds till the freeze point, since they are
-   --  potentially affected by the presence of size and small clauses.
-
    procedure Freeze_Static_Object (E : Entity_Id);
    --  If an object is frozen which has Is_Statically_Allocated set, then
    --  all referenced types must also be marked with this flag. This routine
index c49866f..c5b5b7d 100644 (file)
@@ -698,8 +698,15 @@ package body Lib.Xref is
 
                               if Tref /= Etype (Tref) then
                                  Tref := First_Subtype (Etype (Tref));
-                                 Left := '<';
-                                 Right := '>';
+
+                                 --  Set brackets for derived type, but don't
+                                 --  override pointer case since the fact that
+                                 --  something is a pointer is more important
+
+                                 if Left /= '(' then
+                                    Left := '<';
+                                    Right := '>';
+                                 end if;
 
                               --  If non-derived ptr, get designated type
 
index 2eeb5a0..d4b4778 100644 (file)
@@ -86,7 +86,8 @@ package Prj is
             Value : String_Id := No_String;
       end case;
    end record;
-   --  Values for variables and array elements
+   --  Values for variables and array elements.
+   --  Default is True if the current value is the default one for the variable
 
    Nil_Variable_Value : constant Variable_Value :=
      (Kind     => Undefined,
@@ -383,10 +384,14 @@ package Prj is
       Include_Path : String_Access := null;
       --  The cached value of ADA_INCLUDE_PATH for this project file.
       --  Set by gnatmake (prj.Env.Set_Ada_Paths).
+      --  Do not use this field directly outside of the compiler, use
+      --  Prj.Env.Ada_Source_Path instead.
 
       Objects_Path : String_Access := null;
       --  The cached value of ADA_OBJECTS_PATH for this project file.
       --  Set by gnatmake (prj.Env.Set_Ada_Paths).
+      --  Do not use this field directly outside of the compiler, use
+      --  Prj.Env.Ada_Source_Path instead.
 
       Config_File_Name : Name_Id := No_Name;
       --  The name of the configuration pragmas file, if any.
index c0bc236..a8e2306 100644 (file)
@@ -1555,8 +1555,7 @@ package body Sem_Attr is
             then
                Set_Address_Taken (Entity (P));
 
-            elsif ((Ekind (Entity (P)) = E_Task_Type
-                      or else Ekind (Entity (P)) = E_Protected_Type)
+            elsif (Is_Concurrent_Type (Etype (Entity (P)))
                     and then Etype (Entity (P)) = Base_Type (Entity (P)))
               or else Ekind (Entity (P)) = E_Package
               or else Is_Generic_Unit (Entity (P))
@@ -3740,7 +3739,8 @@ package body Sem_Attr is
       --  array subtype. Sets the variables Index_Lo and Index_Hi to the low
       --  and high bound expressions for the index referenced by the attribute
       --  designator (i.e. the first index if no expression is present, and
-      --  the N'th index if the value N is present as an expression).
+      --  the N'th index if the value N is present as an expression). Also
+      --  used for First and Last of scalar types.
 
       ---------------
       -- Aft_Value --
@@ -4016,6 +4016,14 @@ package body Sem_Attr is
          elsif Is_Scalar_Type (P_Type) then
             Ityp := P_Type;
 
+            if Is_Fixed_Point_Type (P_Type)
+              and then not Is_Frozen (Base_Type (P_Type))
+              and then Compile_Time_Known_Value (Type_Low_Bound (P_Type))
+              and then Compile_Time_Known_Value (Type_High_Bound (P_Type))
+            then
+               Freeze_Fixed_Point_Type (Base_Type (P_Type));
+            end if;
+
          --  For array case, get type of proper index
 
          else
index 2f821b1..71604f6 100644 (file)
@@ -3050,12 +3050,6 @@ package body Sem_Ch12 is
       elsif In_Open_Scopes (Gen_Unit) then
          Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
 
-      elsif Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
-         Error_Msg_Node_2 := Current_Scope;
-         Error_Msg_NE
-           ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
-         Circularity_Detected := True;
-
       elsif K = E_Procedure
         and then Ekind (Gen_Unit) /= E_Generic_Procedure
       then
@@ -3090,6 +3084,14 @@ package body Sem_Ch12 is
             Set_Entity (Gen_Id, Gen_Unit);
          end if;
 
+         if Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
+            Error_Msg_Node_2 := Current_Scope;
+            Error_Msg_NE
+              ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
+            Circularity_Detected := True;
+            return;
+         end if;
+
          if In_Extended_Main_Source_Unit (N) then
             Set_Is_Instantiated (Gen_Unit);
             Generate_Reference  (Gen_Unit, N);