* 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
+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
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;
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
Add_Attributes
(Project,
Name,
- Name_Id (Project.Directory.Name),
+ Name_Id (Project.Directory.Display_Name),
In_Tree.Shared,
Project.Decl,
Prj.Attr.Attribute_First,
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);
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;
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 " &
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));
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 --
--------------------
-- 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