+2013-01-03 Thomas Quinot <quinot@adacore.com>
+
+ * gnat_rm.texi, freeze.adb (Check_Component_Storage_Order): Check that
+ a record extension has the same scalar storage order as the parent type.
+
+2013-01-03 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch4.adb: Add comment.
+
+2013-01-03 Vincent Celier <celier@adacore.com>
+
+ * prj.adb: Minor spelling error correction in comment.
+
+2013-01-03 Vincent Celier <celier@adacore.com>
+
+ * gnatcmd.adb (GNATCmd): If a single main has been specified
+ as an absolute path, use its simple file name to find specific
+ switches, instead of the absolute path.
+
+2013-01-03 Javier Miranda <miranda@adacore.com>
+
+ * sem_warn.adb (Warn_On_Overlapping_Actuals): For overlapping
+ parameters that are record types or array types generate warnings
+ only compiling under -gnatw.i
+ * opt.ads (Extensions_Allowed): Restore previous documentation.
+
+2013-01-03 Vincent Celier <celier@adacore.com>
+
+ * prj-conf.adb (Do_Autoconf): If Target is specified in the
+ main project, but not on the command line, use the Target in
+ the project to invoke gprconfig in auto-configuration.
+ * makeutl.ads (Default_Config_Name): New constant String.
+
+2013-01-03 Arnaud Charlet <charlet@adacore.com>
+
+ * usage.adb: Minor: fix typo in usage.
+
+2013-01-03 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch13.adb (Analyze_Record_Representation_Clause): Reject
+ an illegal component clause for an inherited component in a
+ record extension.
+
2013-01-03 Emmanuel Briot <briot@adacore.com>
* xref_lib.adb (Parse_Identifier_Info): Fix handling of arrays, which
then
return Suitable_Element (Next_Entity (C));
+ -- Below test for C /= Original_Record_Component (C) is dubious
+ -- if Typ is a constrained record subtype???
+
elsif Is_Tagged_Type (Typ)
and then C /= Original_Record_Component (C)
then
Attribute_Scalar_Storage_Order);
if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
- if No (ADC) then
+ if Present (Comp)
+ and then Chars (Comp) = Name_uParent
+ then
+ if Reverse_Storage_Order (Encl_Type)
+ /=
+ Reverse_Storage_Order (Comp_Type)
+ then
+ Error_Msg_N
+ ("record extension must have same scalar storage order as "
+ & "parent", Err_Node);
+ end if;
+
+ elsif No (ADC) then
Error_Msg_N ("nested composite must have explicit scalar "
& "storage order", Err_Node);
elsif (Reverse_Storage_Order (Encl_Type)
/=
- Reverse_Storage_Order (Etype (Comp_Type)))
+ Reverse_Storage_Order (Comp_Type))
and then not Comp_Byte_Aligned
then
Error_Msg_N
clause is not confirming, then the type's @code{Bit_Order} shall be
specified explicitly and set to the same value.
+For a record extension, the derived type shall have the same scalar storage
+order as the parent type.
+
If a component of @var{S} has itself a record or array type, then it shall also
have a @code{Scalar_Storage_Order} attribute definition clause. In addition,
if the component does not start on a byte boundary, then the scalar storage
In_Arrays => Element.Decl.Arrays,
Shared => Project_Tree.Shared);
Name_Len := 0;
- Add_Str_To_Name_Buffer (Main.all);
+
+ -- If the single main has been specified as an absolute
+ -- path, we use only the simple file name. If the
+ -- absolute path is incorrect, an error will be reported
+ -- by the underlying tool and it does not make a
+ -- difference what switches are used.
+
+ if Is_Absolute_Path (Main.all) then
+ Add_Str_To_Name_Buffer (File_Name (Main.all));
+ else
+ Add_Str_To_Name_Buffer (Main.all);
+ end if;
+
The_Switches := Prj.Util.Value_Of
(Index => Name_Find,
Src_Index => 0,
type Fail_Proc is access procedure (S : String);
-- Pointer to procedure which outputs a failure message
+ Default_Config_Name : constant String := "default.cgpr";
+ -- Name of the configuration file used by gprbuild and generated by
+ -- gprconfig by default.
+
On_Windows : constant Boolean := Directory_Separator = '\';
-- True when on Windows
Extensions_Allowed : Boolean := False;
-- GNAT
-- Set to True by switch -gnatX if GNAT specific language extensions
- -- are allowed.
+ -- are allowed. Currently there are no such defined extensions.
type External_Casing_Type is (
As_Is, -- External names cased as they appear in the Ada source
Auto_Cgpr : constant String := "auto.cgpr";
- Default_Name : constant String := "default.cgpr";
- -- Default configuration file that will be used if found
-
Config_Project_Env_Var : constant String := "GPR_CONFIG";
-- Name of the environment variable that provides the name of the
-- configuration file to use.
Free (Tmp);
if T'Length = 0 then
- return Default_Name;
+ return Default_Config_Name;
else
return T;
end if;
Arg_Last := 3;
else
if Target_Name = "" then
- if At_Least_One_Compiler_Command then
- Args (4) := new String'("--target=all");
- else
- Args (4) :=
- new String'("--target=" & Normalized_Hostname);
- end if;
+ -- Check if attribute Target is specified in the main
+ -- project, or in a project it extends. If it is, use this
+ -- target to invoke gprconfig.
+
+ declare
+ Variable : Variable_Value;
+ Proj : Project_Id;
+ Tgt_Name : Name_Id := No_Name;
+ begin
+ Proj := Project;
+ Project_Loop :
+ while Proj /= No_Project loop
+ Variable :=
+ Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
+
+ if Variable /= Nil_Variable_Value and then
+ not Variable.Default and then
+ Variable.Value /= No_Name
+ then
+ Tgt_Name := Variable.Value;
+ exit Project_Loop;
+ end if;
+
+ Proj := Proj.Extends;
+ end loop Project_Loop;
+
+ if Tgt_Name /= No_Name then
+ Args (4) :=
+ new String'("--target=" &
+ Get_Name_String (Tgt_Name));
+
+ elsif At_Least_One_Compiler_Command then
+ Args (4) := new String'("--target=all");
+
+ else
+ Args (4) :=
+ new String'("--target=" & Normalized_Hostname);
+ end if;
+ end;
else
Args (4) := new String'("--target=" & Target_Name);
new Ada.Containers.Ordered_Sets (Element_Type => Name_Id);
Seen_Name : Name_Id_Set.Set;
- -- This set is needed to ensure that we do not haandle the same
+ -- This set is needed to ensure that we do not handle the same
-- project twice in the context of aggregate libraries.
procedure Recursive_Check
Ocomp : Entity_Id;
Posit : Uint;
Rectype : Entity_Id;
+ Recdef : Node_Id;
+
+ function Is_Inherited (Comp : Entity_Id) return Boolean;
+ -- True if Comp is an inherited component in a record extension
+
+ ------------------
+ -- Is_Inherited --
+ ------------------
+
+ function Is_Inherited (Comp : Entity_Id) return Boolean is
+ Comp_Base : Entity_Id;
+ begin
+ if Ekind (Rectype) = E_Record_Subtype then
+ Comp_Base := Original_Record_Component (Comp);
+ else
+ Comp_Base := Comp;
+ end if;
+ return Comp_Base /= Original_Record_Component (Comp_Base);
+ end Is_Inherited;
+
+ Is_Record_Extension : Boolean;
+ -- True if Rectype is a record extension
CR_Pragma : Node_Id := Empty;
-- Points to N_Pragma node if Complete_Representation pragma present
+ -- Start of processing for Analyze_Record_Representation_Clause
+
begin
if Ignore_Rep_Clauses then
return;
return;
end if;
+ -- We know we have a first subtype, now possibly go the the anonymous
+ -- base type to determine whether Rectype is a record extension.
+
+ Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype)));
+ Is_Record_Extension :=
+ Nkind (Recdef) = N_Derived_Type_Definition
+ and then Present (Record_Extension_Part (Recdef));
+
if Present (Mod_Clause (N)) then
declare
Loc : constant Source_Ptr := Sloc (N);
("cannot reference discriminant of unchecked union",
Component_Name (CC));
+ elsif Is_Record_Extension and then Is_Inherited (Comp) then
+ Error_Msg_NE
+ ("component clause not allowed for inherited "
+ & "component&", CC, Comp);
+
elsif Present (Component_Clause (Comp)) then
-- Diagnose duplicate rep clause, or check consistency
Error_Msg_N
("component clause inconsistent "
& "with representation of ancestor", CC);
+
elsif Warn_On_Redundant_Constructs then
Error_Msg_N
- ("?r?redundant component clause "
- & "for inherited component!", CC);
+ ("?r?redundant confirming component clause "
+ & "for component!", CC);
end if;
end;
end if;
begin
if Present (CC1) and then Present (CC2) then
- -- Exclude odd case where we have two tag fields in the same
+ -- Exclude odd case where we have two tag components in the same
-- record, both at location zero. This seems a bit strange, but
-- it seems to happen in some circumstances, perhaps on an error.
procedure Find_Component is
procedure Search_Component (R : Entity_Id);
- -- Search components of R for a match. If found, Comp is set.
+ -- Search components of R for a match. If found, Comp is set
----------------------
-- Search_Component --
Search_Component (Rectype);
- -- If not found, maybe component of base type that is absent from
- -- statically constrained first subtype.
+ -- If not found, maybe component of base type discriminant that is
+ -- absent from statically constrained first subtype.
if No (Comp) then
Search_Component (Base_Type (Rectype));
("bit number out of range of specified size",
Last_Bit (CC));
- -- Check for overlap with tag field
+ -- Check for overlap with tag component
else
if Is_Tagged_Type (Rectype)
Form1, Form2 : Entity_Id;
function Is_Covered_Formal (Formal : Node_Id) return Boolean;
- -- Return True if Formal is covered by the Ada 2012 rule. Under -gnatX
- -- the rule is extended to cover record and array types.
+ -- Return True if Formal is covered by the rule.
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean;
-- Two names are known to refer to the same object if the two names
function Is_Covered_Formal (Formal : Node_Id) return Boolean is
begin
- -- Ada 2012 rule
-
- if not Extensions_Allowed then
- return
- Ekind_In (Formal, E_Out_Parameter,
- E_In_Out_Parameter)
- and then Is_Elementary_Type (Etype (Formal));
-
- -- Under -gnatX the rule is extended to cover array and record types
-
- else
- return
- Ekind_In (Formal, E_Out_Parameter,
- E_In_Out_Parameter)
- and then (Is_Elementary_Type (Etype (Formal))
- or else Is_Record_Type (Etype (Formal))
- or else Is_Array_Type (Etype (Formal)));
- end if;
+ return
+ Ekind_In (Formal, E_Out_Parameter,
+ E_In_Out_Parameter)
+ and then (Is_Elementary_Type (Etype (Formal))
+ or else Is_Record_Type (Etype (Formal))
+ or else Is_Array_Type (Etype (Formal)));
end Is_Covered_Formal;
begin
-- there is no other name among the other parameters of mode in out or
-- out to C that is known to denote the same object (RM 6.4.1(6.15/3))
- -- Under -gnatX the rule is extended to cover array and record types.
+ -- Compiling under -gnatw.i we also report warnings on overlapping
+ -- parameters that are record types or array types.
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
then
null;
+ -- Under Ada 2012 we only report warnings on overlapping
+ -- arrays and record types if compiling under -gnatw.i
+
+ elsif Ada_Version >= Ada_2012
+ and then not Is_Elementary_Type (Etype (Form1))
+ and then not Warn_On_Overlap
+ then
+ null;
+
-- Here we may need to issue message
else
- Error_Msg_Warn := Ada_Version < Ada_2012;
+ Error_Msg_Warn :=
+ Ada_Version < Ada_2012
+ or else not Is_Elementary_Type (Etype (Form1));
declare
Act : Node_Id;
Write_Line (" L* turn off warnings for missing " &
"elaboration pragma");
Write_Line (" .l turn on info messages for inherited aspects");
- Write_Line (" .L* turn off info messages for inherited aspects");
+ Write_Line (" .L* turn off info messages for inherited aspects");
Write_Line (" m+ turn on warnings for variable assigned " &
"but not read");
Write_Line (" M* turn off warnings for variable assigned " &
projects / thirdparty / gcc.git / commitdiff
