2012-10-04 Vincent Celier <celier@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Oct 2012 09:12:18 +0000 (09:12 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Oct 2012 09:12:18 +0000 (09:12 +0000)
* prj-proc.adb (Recursive_Process): Use project directory
display path name as the value of 'Project_Dir.

2012-10-04  Robert Dewar  <dewar@adacore.com>

* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
Deal with case where we get a bignum operand and cannot do a
range analysis.
* sem_eval.adb (Why_Not_Static): Deal with bignum operands

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

* sem_ch4.adb (Find_Unary_Types): Within an instance, an
interpretation that involves a predefied arithmetic operator is
not a candidate if the corresponding generic formal type is not
a numeric type.
* sem_util.ads, sem_util.adb (Corresonding_Generic_Type): If a
type is a generic actual type within an instance, return the
corresponding formal in the generic unit, otherwise return
Any_Type.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/prj-proc.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_eval.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 66a0466..b976f9c 100644 (file)
@@ -1,3 +1,26 @@
+2012-10-04  Vincent Celier  <celier@adacore.com>
+
+       * prj-proc.adb (Recursive_Process): Use project directory
+       display path name as the value of 'Project_Dir.
+
+2012-10-04  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
+       Deal with case where we get a bignum operand and cannot do a
+       range analysis.
+       * sem_eval.adb (Why_Not_Static): Deal with bignum operands
+
+2012-10-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.adb (Find_Unary_Types): Within an instance, an
+       interpretation that involves a predefied arithmetic operator is
+       not a candidate if the corresponding generic formal type is not
+       a numeric type.
+       * sem_util.ads, sem_util.adb (Corresonding_Generic_Type): If a
+       type is a generic actual type within an instance, return the
+       corresponding formal in the generic unit, otherwise return
+       Any_Type.
+
 2012-10-04  Robert Dewar  <dewar@adacore.com>
 
        * checks.adb (Minimize_Eliminate_Overflow_Checks): Dont reanalyze
index 8691437..f47bae4 100644 (file)
@@ -2325,9 +2325,12 @@ package body Exp_Ch4 is
       Minimize_Eliminate_Overflow_Checks
         (Right_Opnd (N), Rlo, Rhi, Top_Level => False);
 
-      --  See if the range information decides the result of the comparison
+      --  See if the range information decides the result of the comparison.
+      --  We can only do this if we in fact have full range information (which
+      --  won't be the case if either operand is bignum at this stage).
 
-      case N_Op_Compare (Nkind (N)) is
+      if Llo /= No_Uint and then Rlo /= No_Uint then
+         case N_Op_Compare (Nkind (N)) is
          when N_Op_Eq =>
             if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
                Set_True;
@@ -2369,12 +2372,13 @@ package body Exp_Ch4 is
             elsif Llo > Rhi or else Lhi < Rlo then
                Set_True;
             end if;
-      end case;
+         end case;
 
-      --  All done if we did the rewrite
+         --  All done if we did the rewrite
 
-      if Nkind (N) not in N_Op_Compare then
-         return;
+         if Nkind (N) not in N_Op_Compare then
+            return;
+         end if;
       end if;
 
       --  Otherwise, time to do the comparison
index 19a92e9..cb9d533 100644 (file)
@@ -2850,7 +2850,7 @@ package body Prj.Proc is
             Add_Attributes
               (Project,
                Name,
-               Name_Id (Project.Directory.Name),
+               Name_Id (Project.Directory.Display_Name),
                In_Tree.Shared,
                Project.Decl,
                Prj.Attr.Attribute_First,
index 64b40e6..9d63e88 100644 (file)
@@ -5888,14 +5888,36 @@ package body Sem_Ch4 is
    begin
       if not Is_Overloaded (R) then
          if Is_Numeric_Type (Etype (R)) then
-            Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
+
+            --  In an instance a generic actual may be a numeric type even if
+            --  the formal in the generic unit was not. In that case, the
+            --  predefined operator was not a possible interpretation in the
+            --  generic, and cannot be one in the instance.
+
+            if In_Instance
+              and then
+                not Is_Numeric_Type (Corresponding_Generic_Type (Etype (R)))
+            then
+               null;
+            else
+               Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
+            end if;
          end if;
 
       else
          Get_First_Interp (R, Index, It);
          while Present (It.Typ) loop
             if Is_Numeric_Type (It.Typ) then
-               Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
+               if In_Instance
+                 and then
+                   not Is_Numeric_Type
+                     (Corresponding_Generic_Type (Etype (It.Typ)))
+               then
+                  null;
+
+               else
+                  Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
+               end if;
             end if;
 
             Get_Next_Interp (Index, It);
index f42bfb3..95a240e 100644 (file)
@@ -37,6 +37,7 @@ with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
+with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
@@ -5419,10 +5420,12 @@ package body Sem_Eval is
             return;
          end if;
 
-         --  Type must be scalar or string type
+         --  Type must be scalar or string type (but allow Bignum, since this
+         --  is really a scalar type from our point of view in this diagnosis).
 
          if not Is_Scalar_Type (Typ)
            and then not Is_String_Type (Typ)
+           and then not Is_RTE (Typ, RE_Bignum)
          then
             Error_Msg_N
               ("static expression must have scalar or string type " &
@@ -5539,7 +5542,14 @@ package body Sem_Eval is
 
          when N_Function_Call =>
             Why_Not_Static_List (Parameter_Associations (N));
-            Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N);
+
+            --  Complain about non-static function call unless we have Bignum
+            --  which means that the underlying expression is really some
+            --  scalar arithmetic operation.
+
+            if not Is_RTE (Typ, RE_Bignum) then
+               Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N);
+            end if;
 
          when N_Parameter_Association =>
             Why_Not_Static (Explicit_Actual_Parameter (N));
index 2e68039..2202c88 100644 (file)
@@ -2489,6 +2489,45 @@ package body Sem_Util is
       return Plist;
    end Copy_Parameter_List;
 
+   --------------------------------
+   -- Corresponding_Generic_Type --
+   --------------------------------
+
+   function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id is
+      Inst : Entity_Id;
+      Gen  : Entity_Id;
+      Typ  : Entity_Id;
+
+   begin
+      if not Is_Generic_Actual_Type (T) then
+         return Any_Type;
+
+      else
+         Inst := Scope (T);
+
+         if Is_Wrapper_Package (Inst) then
+            Inst := Related_Instance (Inst);
+         end if;
+
+         Gen  :=
+           Generic_Parent
+             (Specification (Unit_Declaration_Node (Inst)));
+
+         --  Generic actual has the same name as the corresponding formal
+
+         Typ := First_Entity (Gen);
+         while Present (Typ) loop
+            if Chars (Typ) = Chars (T) then
+               return Typ;
+            end if;
+
+            Next_Entity (Typ);
+         end loop;
+
+         return Any_Type;
+      end if;
+   end Corresponding_Generic_Type;
+
    --------------------
    -- Current_Entity --
    --------------------
index 57c4880..1b089b8 100644 (file)
@@ -299,6 +299,12 @@ package Sem_Util is
    --  create a new compatible record type. Loc is the source location assigned
    --  to the created nodes.
 
+   function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id;
+   --  If a type is a generic actual type, return the corresponding formal in
+   --  the generic parent unit. There is no direct link in the tree for this
+   --  attribute, except in the case of formal private and derived types.
+   --  Possible optimization???
+
    function Current_Entity (N : Node_Id) return Entity_Id;
    pragma Inline (Current_Entity);
    --  Find the currently visible definition for a given identifier, that is to