[multiple changes]

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Mode): Reimplement the routine.
	(Find_Mode): New routine.

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb (Operator_Check): Handle additional
	Allow_Integer_Address cases.

From-SVN: r206835

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 395cc96cfbb843ca91f7d28c088b1b5e8e625427..05db4c0be5a4fd74e8cd525938aa3f502d1609f7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_prag.adb (Check_Mode): Reimplement the routine.
+       (Find_Mode): New routine.
+
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch4.adb (Operator_Check): Handle additional
+       Allow_Integer_Address cases.
+
 2014-01-20  Robert Dewar  <dewar@adacore.com>
 
        * gnat_rm.texi (Allow_Integer_Address): Remove note about not

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index bf4e31774c406b4132e5340786c02416ab6da3eb..c63d423718452d14d7f2af941e5840315a4674ed 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6331,7 +6331,8 @@ package body Sem_Ch4 is
             --  binary operator case.
 
             elsif Junk_Operand (R)
-              or (Nkind (N) in N_Binary_Op and then Junk_Operand (L))
+              or  -- really mean OR here and not OR ELSE, see above
+                (Nkind (N) in N_Binary_Op and then Junk_Operand (L))
             then
                return;
 
@@ -6390,11 +6391,42 @@ package body Sem_Ch4 is
                      Rewrite (L,
                        Unchecked_Convert_To (Etype (R), Relocate_Node (L)));
                      Analyze_Arithmetic_Op (N);
+                     return;
 
                   else
                      Resolve (L, Etype (R));
                   end if;
+
                   return;
+
+               elsif Allow_Integer_Address
+                 and then Is_Descendent_Of_Address (Etype (L))
+                 and then Is_Descendent_Of_Address (Etype (R))
+                 and then not Error_Posted (N)
+               then
+                  declare
+                     Addr_Type : constant Entity_Id := Etype (L);
+
+                  begin
+                     Rewrite (L,
+                       Unchecked_Convert_To (
+                         Standard_Integer, Relocate_Node (L)));
+                     Rewrite (R,
+                       Unchecked_Convert_To (
+                         Standard_Integer, Relocate_Node (R)));
+                     Analyze_Arithmetic_Op (N);
+
+                     --  If this is an operand in an enclosing arithmetic
+                     --  operation, Convert the result as an address so that
+                     --  arithmetic folding of address can continue.
+
+                     if Nkind (Parent (N)) in N_Op then
+                        Rewrite (N,
+                          Unchecked_Convert_To (Addr_Type, Relocate_Node (N)));
+                     end if;
+
+                     return;
+                  end;
                end if;
 
             --  Comparisons on A'Access are common enough to deserve a

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 7520856e3927c41d021019df56d44f2083f23f34..3da7e002dc26611ce719e03c8be1016589f20133 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -953,98 +953,149 @@ package body Sem_Prag is
          Is_Input : Boolean;
          Self_Ref : Boolean)
       is
-      begin
-         --  Input
+         procedure Find_Mode
+           (Is_Input  : out Boolean;
+            Is_Output : out Boolean);
+         --  Find the mode of Item_Id. Flags Is_Input and Is_Output are set
+         --  depending on the mode.
 
-         if Is_Input then
+         ---------------
+         -- Find_Mode --
+         ---------------
 
-            --  IN and IN OUT parameters already have the proper mode to act
-            --  as input. OUT parameters are valid inputs only when their type
-            --  is unconstrained or tagged as their discriminants, array bouns
-            --  or tags can be read. In general, states and variables are
-            --  considered to have mode IN OUT unless they are classified by
-            --  pragma [Refined_]Global. In that case, the item must appear in
-            --  an input global list. OUT parameters of enclosing subprograms
-            --  behave as read-write variables in which case do not emit an
-            --  error.
-
-            if (Ekind (Item_Id) = E_Out_Parameter
-                 and then Scope (Item_Id) = Spec_Id
-                 and then not Is_Unconstrained_Or_Tagged_Item (Item_Id))
-              or else
-                (Global_Seen and then not Appears_In (Subp_Inputs, Item_Id))
-            then
-               Error_Msg_NE
-                 ("item & must have mode IN or `IN OUT`", Item, Item_Id);
-            end if;
+         procedure Find_Mode
+           (Is_Input  : out Boolean;
+            Is_Output : out Boolean)
+         is
+         begin
+            Is_Input  := False;
+            Is_Output := False;
 
-         --  Self-referential output
+            --  Abstract state cases
 
-         elsif Self_Ref then
+            if Ekind (Item_Id) = E_Abstract_State then
 
-            --  In general, states and variables are considered to have mode
-            --  IN OUT unless they are explicitly moded by pragma [Refined_]
-            --  Global. If this is the case, then the item must appear in both
-            --  an input and output global list.
+               --  When pragma Global is present, the mode of the state may be
+               --  further constrained by setting a more restrictive mode.
 
-            if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
-               if Global_Seen
-                 and then not
-                   (Appears_In (Subp_Inputs, Item_Id)
-                      and then
-                    Appears_In (Subp_Outputs, Item_Id))
+               if Global_Seen then
+                  if Appears_In (Subp_Inputs, Item_Id) then
+                     Is_Input := True;
+                  end if;
+
+                  if Appears_In (Subp_Outputs, Item_Id) then
+                     Is_Output := True;
+                  end if;
+
+               --  Otherwise the mode of the state is the one defined in pragma
+               --  Abstract_State. An In_Out state lacks both Input_Only and
+               --  Output_Only modes.
+
+               elsif not Is_Input_Only_State (Item_Id)
+                 and then not Is_Output_Only_State (Item_Id)
                then
-                  Error_Msg_NE
-                    ("item & must have mode `IN OUT`", Item, Item_Id);
+                  Is_Input  := True;
+                  Is_Output := True;
+
+               elsif Is_Input_Only_State (Item_Id) then
+                  Is_Input := True;
+
+               elsif Is_Output_Only_State (Item_Id) then
+                  Is_Output := True;
                end if;
 
-            --  A self-referential OUT parameter of an unconstrained or tagged
-            --  type acts as an input because the discriminants, array bounds
-            --  or the tag may be read. Note that the presence of [Refined_]
-            --  Global is not significant here because the item is a parameter.
-            --  This rule applies only to the formals of the related subprogram
-            --  as OUT parameters of enclosing subprograms behave as read-write
-            --  variables and their types do not matter.
+            --  Parameter cases
 
-            elsif Ekind (Item_Id) = E_Out_Parameter
-              and then Scope (Item_Id) = Spec_Id
-              and then Is_Unconstrained_Or_Tagged_Item (Item_Id)
-            then
-               null;
+            elsif Ekind (Item_Id) = E_In_Parameter then
+               Is_Input := True;
 
-            --  The remaining cases are IN, IN OUT, and OUT parameters. To
-            --  qualify as self-referential item, the parameter must be of
-            --  mode IN OUT or be an IN OUT or OUT parameter of an enclosing
-            --  subprogram.
+            elsif Ekind (Item_Id) = E_In_Out_Parameter then
+               Is_Input  := True;
+               Is_Output := True;
 
-            elsif Scope (Item_Id) = Spec_Id then
-               if Ekind (Item_Id) /= E_In_Out_Parameter then
-                  Error_Msg_NE
-                    ("item & must have mode `IN OUT`", Item, Item_Id);
+            elsif Ekind (Item_Id) = E_Out_Parameter then
+               if Scope (Item_Id) = Spec_Id then
+
+                  --  An OUT parameter of the related subprogram has mode IN
+                  --  if its type is unconstrained or tagged because array
+                  --  bounds, discriminants or tags can be read.
+
+                  if Is_Unconstrained_Or_Tagged_Item (Item_Id) then
+                     Is_Input := True;
+                  end if;
+
+                  Is_Output := True;
+
+               --  An OUT parameter of an enclosing subprogram behaves as a
+               --  read-write variable in which case the mode is IN OUT.
+
+               else
+                  Is_Input  := True;
+                  Is_Output := True;
                end if;
 
-            --  Enclosing subprogram parameter
+            --  Variable cases
 
-            elsif not Ekind_In (Item_Id, E_In_Out_Parameter,
-                                         E_Out_Parameter)
-            then
+            else pragma Assert (Ekind (Item_Id) = E_Variable);
+
+               --  When pragma Global is present, the mode of the variable may
+               --  be further constrained by setting a more restrictive mode.
+
+               if Global_Seen then
+
+                  --  A variable has mode IN when its type is unconstrained or
+                  --  tagged because array bounds, discriminants or tags can be
+                  --  read.
+
+                  if Appears_In (Subp_Inputs, Item_Id)
+                    or else Is_Unconstrained_Or_Tagged_Item (Item_Id)
+                  then
+                     Is_Input := True;
+                  end if;
+
+                  if Appears_In (Subp_Outputs, Item_Id) then
+                     Is_Output := True;
+                  end if;
+
+               --  Otherwise the variable has a default IN OUT mode
+
+               else
+                  Is_Input  := True;
+                  Is_Output := True;
+               end if;
+            end if;
+         end Find_Mode;
+
+         --  Local variables
+
+         Item_Is_Input  : Boolean;
+         Item_Is_Output : Boolean;
+
+      --  Start of processing for Check_Mode
+
+      begin
+         Find_Mode (Item_Is_Input, Item_Is_Output);
+
+         --  Input item
+
+         if Is_Input then
+            if not Item_Is_Input then
                Error_Msg_NE
-                 ("item & must have mode `IN OUT` or `OUT`", Item, Item_Id);
+                 ("item & must have mode `IN` or `IN OUT`", Item, Item_Id);
             end if;
 
-         --  Output
+         --  Self-referential item
 
-         --  IN OUT and OUT parameters already have the proper mode to act as
-         --  output. In general, states and variables are considered to have
-         --  mode IN OUT unless they are moded by pragma [Refined_]Global. In
-         --  that case, the item must appear in an output global list.
+         elsif Self_Ref then
+            if not Item_Is_Input or else not Item_Is_Output then
+               Error_Msg_NE ("item & must have mode `IN OUT`", Item, Item_Id);
+            end if;
 
-         elsif Ekind (Item_Id) = E_In_Parameter
-           or else
-             (Global_Seen and then not Appears_In (Subp_Outputs, Item_Id))
-         then
+         --  Output item
+
+         elsif not Item_Is_Output then
             Error_Msg_NE
-              ("item & must have mode OUT or `IN OUT`", Item, Item_Id);
+              ("item & must have mode `OUT` or `IN OUT`", Item, Item_Id);
          end if;
       end Check_Mode;