Commit f4b049db by Arnaud Charlet

[multiple changes]

2010-09-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration
	of full view analyzed after analyzing the corresponding record
	declaration, to prevent spurious name conflicts with original
	declaration.

2010-09-10  Jerome Lambourg  <lambourg@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the VM case,
	just issue a warning, but continue with the normal processing.

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb, prj-nmsc.adb, sem_ch4.adb, sem_res.adb: Minor
	reformatting.

2010-09-10  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call,
	Build_TypeCode_Call): For a subtype inserted for the expansion of a
	generic actual type, go to the underlying type of the original actual
	type.

2010-09-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Assign_Array_Loop): In CodePeer mode, place a
	guard around the increment statement, to prevent an off-by-one-value
	on the last iteration.

From-SVN: r164185
parent e7c0dd39
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration
of full view analyzed after analyzing the corresponding record
declaration, to prevent spurious name conflicts with original
declaration.
2010-09-10 Jerome Lambourg <lambourg@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the VM case,
just issue a warning, but continue with the normal processing.
2010-09-10 Robert Dewar <dewar@adacore.com>
* exp_attr.adb, prj-nmsc.adb, sem_ch4.adb, sem_res.adb: Minor
reformatting.
2010-09-10 Thomas Quinot <quinot@adacore.com>
* exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call,
Build_TypeCode_Call): For a subtype inserted for the expansion of a
generic actual type, go to the underlying type of the original actual
type.
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Assign_Array_Loop): In CodePeer mode, place a
guard around the increment statement, to prevent an off-by-one-value
on the last iteration.
2010-09-10 Vincent Celier <celier@adacore.com>
* sem_aggr.adb, exp_prag.adb, sem_ch3.adb, exp_attr.adb,
......
......@@ -5519,9 +5519,11 @@ package body Exp_Attr is
-- the compiler will generate in-place stream routines for string types
-- that appear in GNAT's library, but will generate calls via rtsfind
-- to library routines for user code.
-- ??? For now, disable this code for JVM, since this generates a
-- VerifyError exception at run time on e.g. c330001.
-- This is disabled for AAMP, to avoid making dependences on files not
-- This is disabled for AAMP, to avoid creating dependences on files not
-- supported in the AAMP library (such as s-fileio.adb).
if VM_Target /= JVM_Target
......
......@@ -1007,6 +1007,55 @@ package body Exp_Ch5 is
F_Or_L : Name_Id;
S_Or_P : Name_Id;
function Build_Step (J : Nat) return Node_Id;
-- Note that on the last iteration of the loop, the index is increased
-- past the upper bound. This is consistent with the C semantics of the
-- back-end, where such an off-by-one value on a dead variable is OK.
-- However, in CodePeer mode this leads to spurious warnings, and thus
-- we place a guard around the attribute reference.
----------------
-- Build_Step --
----------------
function Build_Step (J : Nat) return Node_Id is
Step : Node_Id;
Lim : Name_Id;
begin
if Rev then
Lim := Name_First;
else
Lim := Name_Last;
end if;
Step :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Rnn (J), Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (R_Index_Type (J), Loc),
Attribute_Name => S_Or_P,
Expressions => New_List (
New_Occurrence_Of (Rnn (J), Loc))));
if CodePeer_Mode then
Step :=
Make_If_Statement (Loc,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Occurrence_Of (Lnn (J), Loc),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (L_Index_Type (J), Loc),
Attribute_Name => Lim)),
Then_Statements => New_List (Step));
end if;
return Step;
end Build_Step;
begin
if Rev then
F_Or_L := Name_Last;
......@@ -1103,18 +1152,7 @@ package body Exp_Ch5 is
Discrete_Subtype_Definition =>
New_Reference_To (L_Index_Type (J), Loc))),
Statements => New_List (
Assign,
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Rnn (J), Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (R_Index_Type (J), Loc),
Attribute_Name => S_Or_P,
Expressions => New_List (
New_Occurrence_Of (Rnn (J), Loc)))))))));
Statements => New_List (Assign, Build_Step (J))))));
end loop;
return Assign;
......
......@@ -8427,6 +8427,15 @@ package body Exp_Dist is
Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any);
-- For the subtype representing a generic actual type, go to the
-- actual type.
if Is_Generic_Actual_Type (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
-- For a standard subtype, go to the base type
if Sloc (U_Type) <= Standard_Location then
U_Type := Base_Type (U_Type);
end if;
......@@ -8516,13 +8525,6 @@ package body Exp_Dist is
Decl : Entity_Id;
begin
-- For the subtype representing a generic actual type, go
-- to the base type.
if Is_Generic_Actual_Type (U_Type) then
U_Type := Base_Type (U_Type);
end if;
Build_From_Any_Function (Loc, U_Type, Decl, Fnam);
Append_To (Decls, Decl);
end;
......@@ -9240,12 +9242,14 @@ package body Exp_Dist is
Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any);
-- Check first for Boolean and Character. These are enumeration
-- types, but we treat them specially, since they may require
-- special handling in the transfer protocol. However, this
-- special handling only applies if they have standard
-- representation, otherwise they are treated like any other
-- enumeration type.
-- For the subtype representing a generic actual type, go to the
-- actual type.
if Is_Generic_Actual_Type (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
-- For a standard subtype, go to the base type
if Sloc (U_Type) <= Standard_Location then
U_Type := Base_Type (U_Type);
......@@ -9254,6 +9258,13 @@ package body Exp_Dist is
if Present (Fnam) then
null;
-- Check first for Boolean and Character. These are enumeration
-- types, but we treat them specially, since they may require
-- special handling in the transfer protocol. However, this
-- special handling only applies if they have standard
-- representation, otherwise they are treated like any other
-- enumeration type.
elsif U_Type = Standard_Boolean then
Lib_RE := RE_TA_B;
......@@ -9380,14 +9391,11 @@ package body Exp_Dist is
Decls : constant List_Id := New_List;
Stms : constant List_Id := New_List;
Expr_Parameter : constant Entity_Id :=
Make_Defining_Identifier (Loc, Name_E);
Any : constant Entity_Id :=
Make_Defining_Identifier (Loc, Name_A);
Expr_Parameter : Entity_Id;
Any : Entity_Id;
Result_TC : Node_Id;
Any_Decl : Node_Id;
Result_TC : Node_Id := Build_TypeCode_Call (Loc, Typ, Decls);
Use_Opaque_Representation : Boolean;
-- When True, use stream attributes and represent type as an
......@@ -9402,12 +9410,16 @@ package body Exp_Dist is
if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then
Build_To_Any_Function
(Loc => Loc,
Typ => Etype (Typ),
Decl => Decl,
Fnam => Fnam);
Typ => Etype (Typ),
Decl => Decl,
Fnam => Fnam);
return;
end if;
Expr_Parameter := Make_Defining_Identifier (Loc, Name_E);
Any := Make_Defining_Identifier (Loc, Name_A);
Result_TC := Build_TypeCode_Call (Loc, Typ, Decls);
Fnam := Make_Helper_Function_Name (Loc, Typ, Name_To_Any);
Spec :=
......@@ -10017,15 +10029,20 @@ package body Exp_Dist is
Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode);
end if;
if No (Fnam) then
if Sloc (U_Type) <= Standard_Location then
-- For the subtype representing a generic actual type, go to the
-- actual type.
-- Do not try to build alias typecodes for subtypes from
-- Standard.
if Is_Generic_Actual_Type (U_Type) then
U_Type := Underlying_Type (Base_Type (U_Type));
end if;
U_Type := Base_Type (U_Type);
end if;
-- For a standard subtype, go to the base type
if Sloc (U_Type) <= Standard_Location then
U_Type := Base_Type (U_Type);
end if;
if No (Fnam) then
if U_Type = Standard_Boolean then
Lib_RE := RE_TC_B;
......
......@@ -5220,6 +5220,7 @@ package body Prj.Nmsc is
end if;
if not Has_Error then
-- We have an existing directory, we register it and all of
-- its subdirectories.
......@@ -5263,8 +5264,10 @@ package body Prj.Nmsc is
end if;
if not Has_Error then
-- links have been resolved if necessary, and Path_Name
-- always ends with a directory separator
-- Links have been resolved if necessary, and Path_Name
-- always ends with a directory separator.
Add_To_Or_Remove_From_Source_Dirs
(Path_Id => Path_Name.Name,
Display_Path_Id => Path_Name.Display_Name,
......
......@@ -1532,17 +1532,16 @@ package body Sem_Ch13 is
Error_Msg_N
("size cannot be given for unconstrained array", Nam);
elsif VM_Target /= No_VM then
-- Size clauses are ignored for VM targets. Display a warning
-- unless we are in GNAT mode, in which case this is useless.
elsif Size /= No_Uint then
if not GNAT_Mode then
if VM_Target /= No_VM and then not GNAT_Mode then
-- Size clause is not handled properly on VM targets.
-- Display a warning unless we are in GNAT mode, in which
-- case this is useless.
Error_Msg_N
("?size clauses are ignored in this configuration", N);
end if;
elsif Size /= No_Uint then
if Is_Type (U_Ent) then
Etyp := U_Ent;
else
......
......@@ -5843,6 +5843,7 @@ package body Sem_Ch3 is
Full_Der := New_Copy (Derived_Type);
Set_Comes_From_Source (Full_Decl, False);
Set_Comes_From_Source (Full_Der, False);
Set_Parent (Full_Der, Full_Decl);
Insert_After (N, Full_Decl);
......@@ -5916,9 +5917,16 @@ package body Sem_Ch3 is
Set_Defining_Identifier (Full_Decl, Full_Der);
Build_Derived_Record_Type
(Full_Decl, Parent_Type, Full_Der, Derive_Subps);
Set_Analyzed (Full_Decl);
end if;
-- The full declaration has been introduced into the tree and
-- processed in the step above. It should not be analyzed again
-- (when encountered later in the current list of declarations)
-- to prevent spurious name conflicts. The full entity remains
-- invisible.
Set_Analyzed (Full_Decl);
if Swapped then
Uninstall_Declarations (Par_Scope);
......
......@@ -3941,12 +3941,11 @@ package body Sem_Ch4 is
else
if Ekind (Prefix_Type) = E_Record_Subtype then
-- Check whether this is a component of the base type
-- which is absent from a statically constrained subtype.
-- This will raise constraint error at run time, but is
-- not a compile-time error. When the selector is illegal
-- for base type as well fall through and generate a
-- compilation error anyway.
-- Check whether this is a component of the base type which
-- is absent from a statically constrained subtype. This will
-- raise constraint error at run time, but is not a compile-
-- time error. When the selector is illegal for base type as
-- well fall through and generate a compilation error anyway.
Comp := First_Component (Base_Type (Prefix_Type));
while Present (Comp) loop
......
......@@ -68,7 +68,7 @@ with Sem_Util; use Sem_Util;
with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinfo.CN; use Sinfo.CN;
with Sinfo.CN; use Sinfo.CN;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
......@@ -1066,6 +1066,7 @@ package body Sem_Res is
-- Rewrite as call if overloadable entity that is (or could be, in the
-- overloaded case) a function call. If we know for sure that the entity
-- is an enumeration literal, we do not rewrite it.
-- If the entity is the name of an operator, it cannot be a call because
-- operators cannot have default parameters. In this case, this must be
-- a string whose contents coincide with an operator name. Set the kind
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment