OSDN Git Service

* s-linux-sparc.ads: New file.
[pf3gnuchains/gcc-fork.git] / gcc / ada / cstand.adb
index 5d16e53..d6f0ff0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -379,13 +379,26 @@ package body CStand is
       Set_Is_Pure (Standard_Standard);
       Set_Is_Compilation_Unit (Standard_Standard);
 
-      --  Create type declaration nodes for standard types
+      --  Create type/subtype declaration nodes for standard types
 
       for S in S_Types loop
-         Decl := New_Node (N_Full_Type_Declaration, Stloc);
-         Set_Defining_Identifier (Decl, Standard_Entity (S));
+
+         --  Subtype declaration case
+
+         if S = S_Natural or else S = S_Positive then
+            Decl := New_Node (N_Subtype_Declaration, Stloc);
+            Set_Subtype_Indication (Decl,
+              New_Occurrence_Of (Standard_Integer, Stloc));
+
+         --  Full type declaration case
+
+         else
+            Decl := New_Node (N_Full_Type_Declaration, Stloc);
+         end if;
+
          Set_Is_Frozen (Standard_Entity (S));
          Set_Is_Public (Standard_Entity (S));
+         Set_Defining_Identifier (Decl, Standard_Entity (S));
          Append (Decl, Decl_S);
       end loop;
 
@@ -768,13 +781,7 @@ package body CStand is
       Set_Entity (E_Id, Standard_Positive);
       Set_Etype (E_Id, Standard_Positive);
 
-      --  Create subtype declaration for Natural
-
-      Decl := New_Node (N_Subtype_Declaration, Stloc);
-      Set_Defining_Identifier (Decl, Standard_Natural);
-      Set_Subtype_Indication (Decl,
-        New_Occurrence_Of (Standard_Integer, Stloc));
-      Append (Decl, Decl_S);
+      --  Setup entity for Naturalend Create_Standard;
 
       Set_Ekind          (Standard_Natural, E_Signed_Integer_Subtype);
       Set_Etype          (Standard_Natural, Base_Type (Standard_Integer));
@@ -788,16 +795,8 @@ package body CStand is
         Lb  => Uint_0,
         Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
       Set_Is_Constrained (Standard_Natural);
-      Set_Is_Frozen      (Standard_Natural);
-      Set_Is_Public      (Standard_Natural);
-
-      --  Create subtype declaration for Positive
 
-      Decl := New_Node (N_Subtype_Declaration, Stloc);
-      Set_Defining_Identifier (Decl, Standard_Positive);
-      Set_Subtype_Indication (Decl,
-        New_Occurrence_Of (Standard_Integer, Stloc));
-      Append (Decl, Decl_S);
+      --  Setup entity for Positive
 
       Set_Ekind          (Standard_Positive, E_Signed_Integer_Subtype);
       Set_Etype          (Standard_Positive, Base_Type (Standard_Integer));
@@ -812,8 +811,6 @@ package body CStand is
          Lb  => Uint_1,
          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
       Set_Is_Constrained   (Standard_Positive);
-      Set_Is_Frozen        (Standard_Positive);
-      Set_Is_Public        (Standard_Positive);
 
       --  Create declaration for package ASCII
 
@@ -936,17 +933,17 @@ package body CStand is
       Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
       Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
       Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
-      Init_Esize         (Standard_Debug_Renaming_Type, 0);
-      Init_RM_Size       (Standard_Debug_Renaming_Type, 0);
+      Init_Esize          (Standard_Debug_Renaming_Type, 0);
+      Init_RM_Size        (Standard_Debug_Renaming_Type, 0);
       Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type);
-      Set_Integer_Bounds (Standard_Debug_Renaming_Type,
-        Typ => Base_Type (Standard_Debug_Renaming_Type),
+      Set_Integer_Bounds  (Standard_Debug_Renaming_Type,
+        Typ => Base_Type  (Standard_Debug_Renaming_Type),
         Lb  => Uint_1,
         Hb  => Uint_0);
-      Set_Is_Constrained (Standard_Debug_Renaming_Type);
+      Set_Is_Constrained  (Standard_Debug_Renaming_Type);
       Set_Has_Size_Clause (Standard_Debug_Renaming_Type);
 
-      Make_Name      (Standard_Debug_Renaming_Type, "_renaming_type");
+      Make_Name           (Standard_Debug_Renaming_Type, "_renaming_type");
 
       --  Note on type names. The type names for the following special types
       --  are constructed so that they will look reasonable should they ever
@@ -1147,6 +1144,7 @@ package body CStand is
       Set_Is_Unsigned_Type  (Standard_Unsigned);
       Set_Size_Known_At_Compile_Time
                             (Standard_Unsigned);
+      Set_Is_Known_Valid    (Standard_Unsigned, True);
 
       R_Node := New_Node (N_Range, Stloc);
       Set_Low_Bound  (R_Node, Make_Integer (Uint_0));
@@ -1314,7 +1312,6 @@ package body CStand is
       begin
          Comp      := First_Entity (Standard_Exception_Type);
          Comp_List := New_List;
-
          while Present (Comp) loop
             Append (
               Make_Component_Declaration (Stloc,
@@ -1490,7 +1487,6 @@ package body CStand is
 
    function Identifier_For (S : Standard_Entity_Type) return Node_Id is
       Ident_Node : Node_Id;
-
    begin
       Ident_Node := New_Node (N_Identifier, Stloc);
       Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
@@ -1730,7 +1726,7 @@ package body CStand is
       Write_Eol;
 
       P ("package Standard is");
-      P ("pragma Pure(Standard);");
+      P ("pragma Pure (Standard);");
       Write_Eol;
 
       P ("   type Boolean is (False, True);");
@@ -1832,7 +1828,7 @@ package body CStand is
       Write_Eol;
 
       P ("   type Wide_Wide_Character is (...)");
-      Write_Str ("   for Wide_Character'Size use ");
+      Write_Str ("   for Wide_Wide_Character'Size use ");
       Write_Int (Standard_Wide_Wide_Character_Size);
       P (";");
       P ("   --  See RM A.1(36) for details of this type");