layout.adb: Minor reformatting.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* layout.adb: Minor reformatting.
	* sem_prag.adb (Analyze_Pragma, case Inspection_Point): Call
	dummy procedure ip.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* restrict.ads (Implementation_Restriction): Add entry for
	No_Fixed_IO.
	* rtsfind.ads: Add entries for Fixed_IO and Decimal_IO in
	Ada.[Wide_[Wide_]Text_IO.
	* s-rident.ads (Restriction_Id): Add entry for No_Fixed_IO.
	* sem_attr.adb (Analyze_Attribute): Disallow fixed point types
	for Img, Image, Value, Wide_Image, Wide_Value, Wide_Wide_Image,
	Wide_Wide_Value if restriction No_Fixed_IO is set.
	* sem_util.adb (Set_Entity_Checks): Check restriction No_Fixed_IO.

From-SVN: r210710

8 files changed, 189 insertions, 50 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c74abd0..547b327 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,23 @@
 2014-05-21  Robert Dewar  <dewar@adacore.com>
 
+	* layout.adb: Minor reformatting.
+	* sem_prag.adb (Analyze_Pragma, case Inspection_Point): Call
+	dummy procedure ip.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* restrict.ads (Implementation_Restriction): Add entry for
+	No_Fixed_IO.
+	* rtsfind.ads: Add entries for Fixed_IO and Decimal_IO in
+	Ada.[Wide_[Wide_]Text_IO.
+	* s-rident.ads (Restriction_Id): Add entry for No_Fixed_IO.
+	* sem_attr.adb (Analyze_Attribute): Disallow fixed point types
+	for Img, Image, Value, Wide_Image, Wide_Value, Wide_Wide_Image,
+	Wide_Wide_Value if restriction No_Fixed_IO is set.
+	* sem_util.adb (Set_Entity_Checks): Check restriction No_Fixed_IO.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
 	* gnatcmd.adb: Minor error msg changes (no upper case letter
 	at start).
 	* sem_ch12.adb, sem_ch5.adb, sem_res.adb, sem_util.adb: Minor
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index fe8ea04..466d1ca 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -270,8 +270,7 @@ package body Layout is
       --  the Integer base type, but it is safe to reduce it to 1 at this
       --  stage, since we will only be loading a single storage unit.
 
-      if Is_Discrete_Type (Etype (E))
-        and then not Has_Alignment_Clause (E)
+      if Is_Discrete_Type (Etype (E)) and then not Has_Alignment_Clause (E)
       then
          loop
             Abits := Abits / 2;
@@ -363,13 +362,13 @@ package body Layout is
 
          --  (E - C1) + C2 = E - (C1 - C2)
 
-         --  If the type is unsigned, then only do the optimization if
-         --  C1 >= C2, to avoid creating a negative literal that can't be
-         --  used with the unsigned type.
+         --  If the type is unsigned then only do the optimization if C1 >= C2,
+         --  to avoid creating a negative literal that can't be used with the
+         --  unsigned type.
 
          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L))
            and then (not Is_Unsigned_Type (Etype (Sinfo.Right_Opnd (L)))
-                       or else Expr_Value (Sinfo.Right_Opnd (L)) >= R)
+                      or else Expr_Value (Sinfo.Right_Opnd (L)) >= R)
          then
             Rewrite_Integer
               (Sinfo.Right_Opnd (L),
@@ -626,8 +625,8 @@ package body Layout is
             --  parameter rather than passing "V" directly.
 
             if Present (Comp)
-               and then Base_Type (Etype (Comp))
-                          = Base_Type (Etype (First_Formal (Ent)))
+               and then Base_Type (Etype (Comp)) =
+                        Base_Type (Etype (First_Formal (Ent)))
             then
                return
                  Make_Function_Call (Loc,
@@ -755,7 +754,8 @@ package body Layout is
          --  Value of the current subscript range is statically known
 
          if Compile_Time_Known_Value (Lo)
-           and then Compile_Time_Known_Value (Hi)
+              and then
+            Compile_Time_Known_Value (Hi)
          then
             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
 
@@ -1092,7 +1092,8 @@ package body Layout is
          --  Value of the current subscript range is statically known
 
          if Compile_Time_Known_Value (Lo)
-           and then Compile_Time_Known_Value (Hi)
+              and then
+            Compile_Time_Known_Value (Hi)
          then
             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
 
@@ -1388,9 +1389,7 @@ package body Layout is
       --  not set by an explicit Object_Size attribute clause, then we reset
       --  the Esize to unknown, since we really don't know it.
 
-      if Unknown_Alignment (E)
-        and then not Has_Size_Clause (E)
-      then
+      if Unknown_Alignment (E) and then not Has_Size_Clause (E) then
          Set_Esize (E, Uint_0);
       end if;
    end Layout_Object;
@@ -2512,12 +2511,12 @@ package body Layout is
          elsif AAMP_On_Target
            and then
              ((Ekind (E) = E_Access_Subprogram_Type
-                  and then Present (Enclosing_Subprogram (E)))
-                or else
-                  (Ekind (E) = E_Anonymous_Access_Subprogram_Type
-                    and then
-                      (not Is_Local_Anonymous_Access (E)
-                        or else Present (Enclosing_Subprogram (E)))))
+                and then Present (Enclosing_Subprogram (E)))
+               or else
+                 (Ekind (E) = E_Anonymous_Access_Subprogram_Type
+                   and then
+                     (not Is_Local_Anonymous_Access (E)
+                       or else Present (Enclosing_Subprogram (E)))))
          then
             Init_Size (E, 2 * System_Address_Size);
          else
@@ -2541,7 +2540,7 @@ package body Layout is
 
          if Opt.True_VMS_Target
            and then (Convention (E) = Convention_C
-                      or else
+                       or else
                      Convention (E) = Convention_CPP)
            and then No (Get_Attribute_Definition_Clause (E, Attribute_Size))
            and then Esize (E) = 64
@@ -2653,14 +2652,12 @@ package body Layout is
          --  component type is known and is a small power of 2 (8, 16, 32, 64),
          --  since this is what will always be used.
 
-         if Ekind (E) = E_Array_Type
-           and then Unknown_Component_Size (E)
-         then
+         if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then
             declare
                CT : constant Entity_Id := Component_Type (E);
 
             begin
-               --  For some reasons, access types can cause trouble, So let's
+               --  For some reason, access types can cause trouble, So let's
                --  just do this for scalar types ???
 
                if Present (CT)
@@ -2700,9 +2697,7 @@ package body Layout is
             --  For these types, we set a corresponding alignment matching
             --  the size if possible, or as large as possible if not.
 
-            if Convention (E) = Convention_Ada
-               and then not Debug_Flag_Q
-            then
+            if Convention (E) = Convention_Ada and then not Debug_Flag_Q then
                Set_Composite_Alignment (E);
             end if;
 
@@ -2724,9 +2719,7 @@ package body Layout is
             --  arrays when passed to subprogram parameters (see special test
             --  in Exp_Ch6.Expand_Actuals).
 
-            if not Is_Packed (E)
-              and then Unknown_Alignment (E)
-            then
+            if not Is_Packed (E) and then Unknown_Alignment (E) then
                if Known_Static_Component_Size (E)
                  and then Component_Size (E) = 1
                then
@@ -2989,12 +2982,8 @@ package body Layout is
 
          if Known_Static_Esize (E) then
             Siz := Esize (E);
-
-         elsif Unknown_Esize (E)
-           and then Known_Static_RM_Size (E)
-         then
+         elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then
             Siz := RM_Size (E);
-
          else
             return;
          end if;
@@ -3102,7 +3091,7 @@ package body Layout is
                             (Unknown_Esize (Comp)
                               or else (Known_Static_Esize (Comp)
                                         and then
-                                         Esize (Comp) =
+                                          Esize (Comp) =
                                               Calign * System_Storage_Unit))
                         then
                            Align := UI_To_Int (Calign);
@@ -3194,9 +3183,7 @@ package body Layout is
       --  For access types, do not set the alignment if the size is less than
       --  the allowed minimum size. This avoids cascaded error messages.
 
-      elsif Is_Access_Type (E)
-        and then Esize (E) < System_Address_Size
-      then
+      elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then
          return;
       end if;
 
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index cef3167..882cb84 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -120,6 +120,7 @@ package Restrict is
       No_Exception_Propagation           => True,
       No_Exception_Registration          => True,
       No_Finalization                    => True,
+      No_Fixed_IO                        => True,
       No_Implementation_Attributes       => True,
       No_Implementation_Pragmas          => True,
       No_Implicit_Conditionals           => True,
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 5fcfb31..1f50db3 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -108,8 +108,9 @@ package Rtsfind is
    --  ambiguities).
 
    type RTU_Id is (
-      --  Runtime packages, for list of accessible entities in each
-      --  package see declarations in the runtime entity table below.
+
+      --  Runtime packages, for list of accessible entities in each package,
+      --  see declarations in the runtime entity table below.
 
       RTU_Null,
       --  Used as a null entry (will cause an error if referenced)
@@ -132,6 +133,9 @@ package Rtsfind is
       Ada_Tags,
       Ada_Task_Identification,
       Ada_Task_Termination,
+      Ada_Text_IO,
+      Ada_Wide_Text_IO,
+      Ada_Wide_Wide_Text_IO,
 
       --  Children of Ada.Calendar
 
@@ -701,6 +705,15 @@ package Rtsfind is
      RE_Current_Task,                    -- Ada.Task_Identification
      RO_AT_Task_Id,                      -- Ada.Task_Identification
 
+     RE_Decimal_IO,                      -- Ada.Text_IO
+     RE_Fixed_IO,                        -- Ada.Text_IO
+
+     RO_WT_Decimal_IO,                   -- Ada.Wide_Text_IO
+     RO_WT_Fixed_IO,                     -- Ada.Wide_Text_IO
+
+     RO_WW_Decimal_IO,                   -- Ada.Wide_Wide_Text_IO
+     RO_WW_Fixed_IO,                     -- Ada.Wide_Wide_Text_IO
+
      RE_Integer_8,                       -- Interfaces
      RE_Integer_16,                      -- Interfaces
      RE_Integer_32,                      -- Interfaces
@@ -1973,6 +1986,15 @@ package Rtsfind is
      RE_Current_Task                     => Ada_Task_Identification,
      RO_AT_Task_Id                       => Ada_Task_Identification,
 
+     RE_Decimal_IO                       => Ada_Text_IO,
+     RE_Fixed_IO                         => Ada_Text_IO,
+
+     RO_WT_Decimal_IO                    => Ada_Wide_Text_IO,
+     RO_WT_Fixed_IO                      => Ada_Wide_Text_IO,
+
+     RO_WW_Decimal_IO                    => Ada_Wide_Wide_Text_IO,
+     RO_WW_Fixed_IO                      => Ada_Wide_Wide_Text_IO,
+
      RE_Integer_8                        => Interfaces,
      RE_Integer_16                       => Interfaces,
      RE_Integer_32                       => Interfaces,
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index a7334c8..4f22a19 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -112,6 +112,7 @@ package System.Rident is
       No_Exception_Registration,                 -- GNAT
       No_Exceptions,                             -- (RM H.4(12))
       No_Finalization,                           -- GNAT
+      No_Fixed_IO,                               -- GNAT
       No_Fixed_Point,                            -- (RM H.4(15))
       No_Floating_Point,                         -- (RM H.4(14))
       No_IO,                                     -- (RM H.4(20))
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7ca8c22..968ba00 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3627,6 +3627,16 @@ package body Sem_Attr is
          Resolve (E1, P_Base_Type);
          Check_Enum_Image;
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO. Note the check of Comes_From_Source
+         --  to avoid giving a duplicate message for Img expanded into Image.
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Comes_From_Source (N)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Image;
 
       ---------
@@ -3646,6 +3656,14 @@ package body Sem_Attr is
          end if;
 
          Check_Enum_Image;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Img;
 
       -----------
@@ -6458,6 +6476,14 @@ package body Sem_Attr is
 
          Set_Etype (N, P_Base_Type);
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Value;
 
       ----------------
@@ -6498,6 +6524,14 @@ package body Sem_Attr is
          Check_E1;
          Resolve (E1, P_Base_Type);
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Wide_Image;
 
       ---------------------
@@ -6511,6 +6545,14 @@ package body Sem_Attr is
          Check_E1;
          Resolve (E1, P_Base_Type);
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Wide_Wide_Image;
 
       ----------------
@@ -6528,6 +6570,14 @@ package body Sem_Attr is
 
          Set_Etype (N, P_Type);
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Wide_Value;
 
       ---------------------
@@ -6544,6 +6594,14 @@ package body Sem_Attr is
 
          Set_Etype (N, P_Type);
          Validate_Non_Static_Attribute_Function_Call;
+
+         --  Check restriction No_Fixed_IO
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
       end Wide_Wide_Value;
 
       ---------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 62caba6..3060720 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15327,7 +15327,26 @@ package body Sem_Prag is
             Arg : Node_Id;
             Exp : Node_Id;
 
+            procedure ip;
+            --  A dummy procedure called when pragma Inspection_Point is
+            --  analyzed. This is just to help debugging the front end. If
+            --  a pragma Inspection_Point is added to a source program, then
+            --  breaking on ip will get you to that point in the program.
+
+            --------
+            -- ip --
+            --------
+
+            procedure ip is
+            begin
+               null;
+            end ip;
+
+         --  Start of processing for Inspection_Point
+
          begin
+            ip;
+
             if Arg_Count > 0 then
                Arg := Arg1;
                loop
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 84570fb..afb62c1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -15867,12 +15867,6 @@ package body Sem_Util is
 
       Set_Entity (N, Val);
 
-      --  Remaining checks are only done on source nodes
-
-      if not Comes_From_Source (N) then
-         return;
-      end if;
-
       --  The node to post on is the selector in the case of an expanded name,
       --  and otherwise the node itself.
 
@@ -15882,6 +15876,44 @@ package body Sem_Util is
          Post_Node := N;
       end if;
 
+      --  Check for violation of No_Fixed_IO
+
+      if Restriction_Check_Required (No_Fixed_IO)
+        and then
+          ((RTU_Loaded (Ada_Text_IO)
+             and then (Is_RTE (Val, RE_Decimal_IO)
+                         or else
+                       Is_RTE (Val, RE_Fixed_IO)))
+
+         or else
+           (RTU_Loaded (Ada_Wide_Text_IO)
+             and then (Is_RTE (Val, RO_WT_Decimal_IO)
+                         or else
+                       Is_RTE (Val, RO_WT_Fixed_IO)))
+
+         or else
+           (RTU_Loaded (Ada_Wide_Wide_Text_IO)
+             and then (Is_RTE (Val, RO_WW_Decimal_IO)
+                         or else
+                       Is_RTE (Val, RO_WW_Fixed_IO))))
+
+        --  A special extra check, don't complain about a reference from within
+        --  the Ada.Interrupts package itself!
+
+        and then not In_Same_Extended_Unit (N, Val)
+      then
+         Check_Restriction (No_Fixed_IO, Post_Node);
+      end if;
+
+      --  Remaining checks are only done on source nodes. Note that we test
+      --  for violation of No_Fixed_IO even on non-source nodes, because the
+      --  cases for checking violations of this restriction are instantiations
+      --  where the refernece in the instance has Comes_From_Source False.
+
+      if not Comes_From_Source (N) then
+         return;
+      end if;
+
       --  Check for violation of No_Abort_Statements, which is triggered by
       --  call to Ada.Task_Identification.Abort_Task.
 
@@ -15907,6 +15939,7 @@ package body Sem_Util is
                   Is_RTE (Val, RE_Exchange_Handler) or else
                   Is_RTE (Val, RE_Detach_Handler)   or else
                   Is_RTE (Val, RE_Reference))
+
         --  A special extra check, don't complain about a reference from within
         --  the Ada.Interrupts package itself!