Skip to content

R
riscv-gcc-1
Commit 8190087e by Arnaud Charlet
Options

[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
parent 6f5c2c4b
Showing with 189 additions and 45 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_ch4.adb
......@@ -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
......
gcc/ada/freeze.adb
......@@ -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
......
gcc/ada/gnat_rm.texi
......@@ -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
......
gcc/ada/gnatcmd.adb
......@@ -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,
......
gcc/ada/makeutl.ads
......@@ -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
......
gcc/ada/opt.ads
......@@ -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
......
gcc/ada/prj-conf.adb
......@@ -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);
......
gcc/ada/prj.adb
......@@ -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
......
gcc/ada/sem_ch13.adb
......@@ -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)
......
gcc/ada/sem_warn.adb
......@@ -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;
......
gcc/ada/usage.adb
......@@ -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 " &
......
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