+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,
-- 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
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;
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;
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;
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;
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);
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;
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
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 :=
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;
end if;
if not Has_Error then
+
-- We have an existing directory, we register it and all of
-- its subdirectories.
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,
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
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);
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);
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
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;
-- 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
projects / thirdparty / gcc.git / commitdiff
