[multiple changes]
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. From-SVN: r194849
This commit is contained in:
Arnaud Charlet
parent
6f5c2c4b49
commit
8190087e81
|
|
@ -1,3 +1,46 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -10693,6 +10693,9 @@ package body Exp_Ch4 is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -1094,13 +1094,25 @@ package body Freeze is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -6852,6 +6852,9 @@ This means that if a @code{Scalar_Storage_Order} attribute definition
|
|||
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
|
||||
|
|
|
|||
|
|
@ -1999,7 +1999,19 @@ begin
|
|||
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,
|
||||
|
|
|
|||
|
|
@ -44,6 +44,10 @@ package Makeutl is
|
|||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -563,7 +563,7 @@ package Opt is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -48,9 +48,6 @@ package body Prj.Conf is
|
|||
|
||||
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.
|
||||
|
|
@ -669,7 +666,7 @@ package body Prj.Conf is
|
|||
Free (Tmp);
|
||||
|
||||
if T'Length = 0 then
|
||||
return Default_Name;
|
||||
return Default_Config_Name;
|
||||
else
|
||||
return T;
|
||||
end if;
|
||||
|
|
@ -1183,13 +1180,46 @@ package body Prj.Conf is
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -563,7 +563,7 @@ package body Prj is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -4663,10 +4663,34 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
|
@ -4706,6 +4730,14 @@ package body Sem_Ch13 is
|
|||
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);
|
||||
|
|
@ -4881,6 +4913,11 @@ package body Sem_Ch13 is
|
|||
("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
|
||||
|
|
@ -4908,10 +4945,11 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
|
@ -7346,7 +7384,7 @@ package body Sem_Ch13 is
|
|||
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.
|
||||
|
||||
|
|
@ -7387,7 +7425,7 @@ package body Sem_Ch13 is
|
|||
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 --
|
||||
|
|
@ -7426,8 +7464,8 @@ package body Sem_Ch13 is
|
|||
|
||||
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));
|
||||
|
|
@ -7555,7 +7593,7 @@ package body Sem_Ch13 is
|
|||
("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)
|
||||
|
|
|
|||
|
|
@ -3293,8 +3293,7 @@ package body Sem_Warn is
|
|||
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
|
||||
|
|
@ -3321,24 +3320,12 @@ package body Sem_Warn is
|
|||
|
||||
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
|
||||
|
|
@ -3360,7 +3347,8 @@ package body Sem_Warn is
|
|||
-- 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);
|
||||
|
|
@ -3401,10 +3389,21 @@ package body Sem_Warn is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -502,7 +502,7 @@ begin
|
|||
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 " &
|
||||
|
|
|
|||
Loading…
Reference in New Issue