Skip to content

R
riscv-gcc-1
Commit 5b75bf57 by Arnaud Charlet
Options

[multiple changes] 

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, sem_attr.adb, gnat1drv.adb, prj-makr.adb,
	opt.ads, sem_ch13.adb: Minor reformatting.
	* debug.adb: Minor comment fix (remove junk .I doc).

2013-04-11  Thomas Quinot  <quinot@adacore.com>

	* rtsfind.ads, exp_dist.adb, exp_dist.ads (Rtsfind.PCS_Version, case
	PolyORB): Bump to 6.
	(Exp_Dist.PolyORB_Support): Replace TC_Build with
	Build_Complex_TC.

From-SVN: r197752
parent 303fbb20
Showing with 83 additions and 51 deletions
gcc/ada/ChangeLog
2013-04-11 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_attr.adb, gnat1drv.adb, prj-makr.adb,
opt.ads, sem_ch13.adb: Minor reformatting.
* debug.adb: Minor comment fix (remove junk .I doc).
2013-04-11 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_dist.adb, exp_dist.ads (Rtsfind.PCS_Version, case
PolyORB): Bump to 6.
(Exp_Dist.PolyORB_Support): Replace TC_Build with
Build_Complex_TC.
2013-04-11 Arnaud Charlet <charlet@adacore.com> 2013-04-11 Arnaud Charlet <charlet@adacore.com>
* debug.adb, sem_prag.adb, par-ch2.adb, sem_attr.adb, gnat1drv.adb, * debug.adb, sem_prag.adb, par-ch2.adb, sem_attr.adb, gnat1drv.adb,
......
gcc/ada/debug.adb
...@@ -609,10 +609,6 @@ package body Debug is ...@@ -609,10 +609,6 @@ package body Debug is
-- will only generate Why code for package Standard. Any given input -- will only generate Why code for package Standard. Any given input
-- file will be ignored. -- file will be ignored.
-- d.I Generate SCIL mode. Generate intermediate code for the sake of
-- of static analysis tools, and ensure additional tree consistency
-- between different compilations of specs.
-- d.J Disable parallel SCIL generation. Normally SCIL file generation is -- d.J Disable parallel SCIL generation. Normally SCIL file generation is
-- done in parallel to speed processing. This switch disables this -- done in parallel to speed processing. This switch disables this
-- behavior. -- behavior.
......
gcc/ada/exp_dist.adb
...@@ -6630,9 +6630,10 @@ package body Exp_Dist is ...@@ -6630,9 +6630,10 @@ package body Exp_Dist is
Make_Simple_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_TC_Build), Loc), Name =>
New_Occurrence_Of (RTE (RE_Build_Complex_TC), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (RTE (RE_TC_Object), Loc), New_Occurrence_Of (RTE (RE_Tk_Objref), Loc),
Make_Aggregate (Loc, Make_Aggregate (Loc,
Expressions => Expressions =>
New_List ( New_List (
...@@ -10207,11 +10208,11 @@ package body Exp_Dist is ...@@ -10207,11 +10208,11 @@ package body Exp_Dist is
function Make_Constructed_TypeCode function Make_Constructed_TypeCode
(Kind : Entity_Id; (Kind : Entity_Id;
Parameters : List_Id) return Node_Id; Parameters : List_Id) return Node_Id;
-- Call TC_Build with the given kind and parameters -- Call Build_Complex_TC with the given kind and parameters
procedure Return_Constructed_TypeCode (Kind : Entity_Id); procedure Return_Constructed_TypeCode (Kind : Entity_Id);
-- Make a return statement that calls TC_Build with the given -- Make a return statement that calls Build_Complex_TC with the
-- typecode kind, and the constructed parameters list. -- given typecode kind, and the constructed parameters list.
procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id); procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id);
-- Return a typecode that is a TC_Alias for the given typecode -- Return a typecode that is a TC_Alias for the given typecode
...@@ -10285,7 +10286,7 @@ package body Exp_Dist is ...@@ -10285,7 +10286,7 @@ package body Exp_Dist is
procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id) is procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id) is
begin begin
Add_TypeCode_Parameter (Base_TypeCode, Parameters); Add_TypeCode_Parameter (Base_TypeCode, Parameters);
Return_Constructed_TypeCode (RTE (RE_TC_Alias)); Return_Constructed_TypeCode (RTE (RE_Tk_Alias));
end Return_Alias_TypeCode; end Return_Alias_TypeCode;
------------------------------- -------------------------------
...@@ -10299,7 +10300,7 @@ package body Exp_Dist is ...@@ -10299,7 +10300,7 @@ package body Exp_Dist is
Constructed_TC : constant Node_Id := Constructed_TC : constant Node_Id :=
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => Name =>
New_Occurrence_Of (RTE (RE_TC_Build), Loc), New_Occurrence_Of (RTE (RE_Build_Complex_TC), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Kind, Loc), New_Occurrence_Of (Kind, Loc),
Make_Aggregate (Loc, Make_Aggregate (Loc,
...@@ -10420,7 +10421,7 @@ package body Exp_Dist is ...@@ -10420,7 +10421,7 @@ package body Exp_Dist is
Add_TypeCode_Parameter Add_TypeCode_Parameter
(Make_Constructed_TypeCode (Make_Constructed_TypeCode
(RTE (RE_TC_Struct), Struct_TC_Params), (RTE (RE_Tk_Struct), Struct_TC_Params),
Union_TC_Params); Union_TC_Params);
Add_String_Parameter (Name_Str, Union_TC_Params); Add_String_Parameter (Name_Str, Union_TC_Params);
...@@ -10439,7 +10440,7 @@ package body Exp_Dist is ...@@ -10439,7 +10440,7 @@ package body Exp_Dist is
Add_TypeCode_Parameter Add_TypeCode_Parameter
(Make_Constructed_TypeCode (Make_Constructed_TypeCode
(RTE (RE_TC_Union), Union_TC_Params), (RTE (RE_Tk_Union), Union_TC_Params),
Params); Params);
Add_String_Parameter (Name_Str, Params); Add_String_Parameter (Name_Str, Params);
...@@ -10687,7 +10688,7 @@ package body Exp_Dist is ...@@ -10687,7 +10688,7 @@ package body Exp_Dist is
TC_Append_Record_Traversal TC_Append_Record_Traversal
(Parameters, Component_List (Rdef), (Parameters, Component_List (Rdef),
Empty, Dummy_Counter); Empty, Dummy_Counter);
Return_Constructed_TypeCode (RTE (RE_TC_Struct)); Return_Constructed_TypeCode (RTE (RE_Tk_Struct));
end; end;
end if; end if;
...@@ -10705,7 +10706,7 @@ package body Exp_Dist is ...@@ -10705,7 +10706,7 @@ package body Exp_Dist is
for J in 1 .. Ndim loop for J in 1 .. Ndim loop
if Constrained then if Constrained then
Inner_TypeCode := Make_Constructed_TypeCode Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Array), New_List ( (RTE (RE_Tk_Array), New_List (
Build_To_Any_Call (Loc, Build_To_Any_Call (Loc,
OK_Convert_To (RTE (RE_Unsigned_32), OK_Convert_To (RTE (RE_Unsigned_32),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -10731,7 +10732,7 @@ package body Exp_Dist is ...@@ -10731,7 +10732,7 @@ package body Exp_Dist is
Next_Index (Indx); Next_Index (Indx);
Inner_TypeCode := Make_Constructed_TypeCode Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Sequence), New_List ( (RTE (RE_Tk_Sequence), New_List (
Build_To_Any_Call (Loc, Build_To_Any_Call (Loc,
OK_Convert_To (RTE (RE_Unsigned_32), OK_Convert_To (RTE (RE_Unsigned_32),
Make_Integer_Literal (Loc, 0)), Make_Integer_Literal (Loc, 0)),
...@@ -10747,7 +10748,7 @@ package body Exp_Dist is ...@@ -10747,7 +10748,7 @@ package body Exp_Dist is
Start_String; Start_String;
Store_String_Char ('V'); Store_String_Char ('V');
Add_String_Parameter (End_String, Parameters); Add_String_Parameter (End_String, Parameters);
Return_Constructed_TypeCode (RTE (RE_TC_Struct)); Return_Constructed_TypeCode (RTE (RE_Tk_Struct));
end if; end if;
end; end;
......
gcc/ada/exp_dist.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,7 +35,7 @@ package Exp_Dist is ...@@ -35,7 +35,7 @@ package Exp_Dist is
PCS_Version_Number : constant array (PCS_Names) of Int := PCS_Version_Number : constant array (PCS_Names) of Int :=
(Name_No_DSA => 1, (Name_No_DSA => 1,
Name_GARLIC_DSA => 1, Name_GARLIC_DSA => 1,
Name_PolyORB_DSA => 5); Name_PolyORB_DSA => 6);
-- PCS interface version. This is used to check for consistency between the -- PCS interface version. This is used to check for consistency between the
-- compiler used to generate distribution stubs and the PCS implementation. -- compiler used to generate distribution stubs and the PCS implementation.
-- It must be incremented whenever a change is made to the generated code -- It must be incremented whenever a change is made to the generated code
......
gcc/ada/gnat1drv.adb
...@@ -275,7 +275,11 @@ procedure Gnat1drv is ...@@ -275,7 +275,11 @@ procedure Gnat1drv is
Force_ALI_Tree_File := True; Force_ALI_Tree_File := True;
Try_Semantics := True; Try_Semantics := True;
-- Make the Ada front-end more liberal to support other Ada compilers -- Make the Ada front-end more liberal so that the compiler will
-- allow illegal code that is allowed by other compilers. CodePeer
-- is in the business of finding problems, not enforcing rules!
-- This is useful when using CodePeer mode with other compilers.
Relaxed_RM_Semantics := True; Relaxed_RM_Semantics := True;
end if; end if;
......
gcc/ada/opt.ads
...@@ -1191,7 +1191,12 @@ package Opt is ...@@ -1191,7 +1191,12 @@ package Opt is
Relaxed_RM_Semantics : Boolean := False; Relaxed_RM_Semantics : Boolean := False;
-- GNAT -- GNAT
-- Set to True to ignore some Ada semantic error to help parse legacy -- Set to True to ignore some Ada semantic error to help parse legacy
-- Ada code for use in e.g. static analysis (such as CodePeer). -- Ada code for use in e.g. static analysis (such as CodePeer). This
-- deals with cases where other compilers allow illegal constructs. Tools
-- such as CodePeer are interested in analyzing code rather than enforcing
-- legality rules, so as long as these illegal constructs end up with code
-- that can be handled by the tool in question, there is no reason to
-- reject the code that is considered correct by the other compiler.
Replace_In_Comments : Boolean := False; Replace_In_Comments : Boolean := False;
-- GNATPREP -- GNATPREP
......
gcc/ada/prj-makr.adb
...@@ -1048,31 +1048,34 @@ package body Prj.Makr is ...@@ -1048,31 +1048,34 @@ package body Prj.Makr is
Project_File_Extension; Project_File_Extension;
Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
-- Back up project file if it already exists -- Back up project file if it already exists (not needed in VMS since
-- versioning of files takes care of this requirement on VMS).
if not Hostparm.OpenVMS if not Hostparm.OpenVMS
and then not Opt.No_Backup and then not Opt.No_Backup
and then and then Is_Regular_File (Path_Name (1 .. Path_Last))
Is_Regular_File (Path_Name (1 .. Path_Last))
then then
declare declare
Discard : Boolean; Discard : Boolean;
Saved_Path : constant String := Saved_Path : constant String :=
Path_Name (1 .. Path_Last) & ".saved_"; Path_Name (1 .. Path_Last) & ".saved_";
Nmb : Natural := 0; Nmb : Natural;
begin begin
Nmb := 0;
loop loop
declare declare
Img : constant String := Nmb'Img; Img : constant String := Nmb'Img;
begin begin
if not Is_Regular_File if not Is_Regular_File
(Saved_Path & Img (2 .. Img'Last)) (Saved_Path & Img (2 .. Img'Last))
then then
Copy_File Copy_File
(Name => Path_Name (1 .. Path_Last), (Name => Path_Name (1 .. Path_Last),
Pathname => Saved_Path & Img (2 .. Img'Last), Pathname => Saved_Path & Img (2 .. Img'Last),
Mode => Overwrite, Mode => Overwrite,
Success => Discard); Success => Discard);
exit; exit;
end if; end if;
......
gcc/ada/rtsfind.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1307,6 +1307,9 @@ package Rtsfind is ...@@ -1307,6 +1307,9 @@ package Rtsfind is
RE_Release_Buffer, -- System.Partition_Interface RE_Release_Buffer, -- System.Partition_Interface
RE_BS_To_Any, -- System.Partition_Interface RE_BS_To_Any, -- System.Partition_Interface
RE_Any_To_BS, -- System.Partition_Interface RE_Any_To_BS, -- System.Partition_Interface
RE_Build_Complex_TC, -- System.Partition_Interface
RE_Get_TC, -- System.Partition_Interface
RE_Set_TC, -- System.Partition_Interface
RE_FA_A, -- System.Partition_Interface RE_FA_A, -- System.Partition_Interface
RE_FA_B, -- System.Partition_Interface RE_FA_B, -- System.Partition_Interface
...@@ -1350,10 +1353,6 @@ package Rtsfind is ...@@ -1350,10 +1353,6 @@ package Rtsfind is
RE_TA_Std_String, -- System.Partition_Interface RE_TA_Std_String, -- System.Partition_Interface
RE_TA_TC, -- System.Partition_Interface RE_TA_TC, -- System.Partition_Interface
RE_TC_Alias, -- System.Partition_Interface
RE_TC_Build, -- System.Partition_Interface
RE_Get_TC, -- System.Partition_Interface
RE_Set_TC, -- System.Partition_Interface
RE_TC_A, -- System.Partition_Interface RE_TC_A, -- System.Partition_Interface
RE_TC_B, -- System.Partition_Interface RE_TC_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface RE_TC_C, -- System.Partition_Interface
...@@ -1373,12 +1372,14 @@ package Rtsfind is ...@@ -1373,12 +1372,14 @@ package Rtsfind is
RE_TC_Opaque, -- System.Partition_Interface RE_TC_Opaque, -- System.Partition_Interface
RE_TC_WC, -- System.Partition_Interface RE_TC_WC, -- System.Partition_Interface
RE_TC_WWC, -- System.Partition_Interface RE_TC_WWC, -- System.Partition_Interface
RE_TC_Array, -- System.Partition_Interface
RE_TC_Sequence, -- System.Partition_Interface
RE_TC_String, -- System.Partition_Interface RE_TC_String, -- System.Partition_Interface
RE_TC_Struct, -- System.Partition_Interface
RE_TC_Union, -- System.Partition_Interface RE_Tk_Alias, -- System.Partition_Interface
RE_TC_Object, -- System.Partition_Interface RE_Tk_Array, -- System.Partition_Interface
RE_Tk_Sequence, -- System.Partition_Interface
RE_Tk_Struct, -- System.Partition_Interface
RE_Tk_Objref, -- System.Partition_Interface
RE_Tk_Union, -- System.Partition_Interface
RE_IS_Is1, -- System.Scalar_Values RE_IS_Is1, -- System.Scalar_Values
RE_IS_Is2, -- System.Scalar_Values RE_IS_Is2, -- System.Scalar_Values
...@@ -2550,6 +2551,9 @@ package Rtsfind is ...@@ -2550,6 +2551,9 @@ package Rtsfind is
RE_Release_Buffer => System_Partition_Interface, RE_Release_Buffer => System_Partition_Interface,
RE_BS_To_Any => System_Partition_Interface, RE_BS_To_Any => System_Partition_Interface,
RE_Any_To_BS => System_Partition_Interface, RE_Any_To_BS => System_Partition_Interface,
RE_Build_Complex_TC => System_Partition_Interface,
RE_Get_TC => System_Partition_Interface,
RE_Set_TC => System_Partition_Interface,
RE_FA_A => System_Partition_Interface, RE_FA_A => System_Partition_Interface,
RE_FA_B => System_Partition_Interface, RE_FA_B => System_Partition_Interface,
...@@ -2593,10 +2597,6 @@ package Rtsfind is ...@@ -2593,10 +2597,6 @@ package Rtsfind is
RE_TA_Std_String => System_Partition_Interface, RE_TA_Std_String => System_Partition_Interface,
RE_TA_TC => System_Partition_Interface, RE_TA_TC => System_Partition_Interface,
RE_TC_Alias => System_Partition_Interface,
RE_TC_Build => System_Partition_Interface,
RE_Get_TC => System_Partition_Interface,
RE_Set_TC => System_Partition_Interface,
RE_TC_A => System_Partition_Interface, RE_TC_A => System_Partition_Interface,
RE_TC_B => System_Partition_Interface, RE_TC_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface, RE_TC_C => System_Partition_Interface,
...@@ -2616,12 +2616,14 @@ package Rtsfind is ...@@ -2616,12 +2616,14 @@ package Rtsfind is
RE_TC_Opaque => System_Partition_Interface, RE_TC_Opaque => System_Partition_Interface,
RE_TC_WC => System_Partition_Interface, RE_TC_WC => System_Partition_Interface,
RE_TC_WWC => System_Partition_Interface, RE_TC_WWC => System_Partition_Interface,
RE_TC_Array => System_Partition_Interface,
RE_TC_Sequence => System_Partition_Interface,
RE_TC_String => System_Partition_Interface, RE_TC_String => System_Partition_Interface,
RE_TC_Struct => System_Partition_Interface,
RE_TC_Union => System_Partition_Interface, RE_Tk_Alias => System_Partition_Interface,
RE_TC_Object => System_Partition_Interface, RE_Tk_Array => System_Partition_Interface,
RE_Tk_Sequence => System_Partition_Interface,
RE_Tk_Struct => System_Partition_Interface,
RE_Tk_Objref => System_Partition_Interface,
RE_Tk_Union => System_Partition_Interface,
RE_Global_Pool_Object => System_Pool_Global, RE_Global_Pool_Object => System_Pool_Global,
......
gcc/ada/sem_attr.adb
...@@ -5016,6 +5016,8 @@ package body Sem_Attr is ...@@ -5016,6 +5016,8 @@ package body Sem_Attr is
then then
null; null;
-- Some other compilers allow dubious use of X'???'Size
elsif Relaxed_RM_Semantics elsif Relaxed_RM_Semantics
and then Nkind (P) = N_Attribute_Reference and then Nkind (P) = N_Attribute_Reference
then then
......
gcc/ada/sem_ch13.adb
...@@ -9002,6 +9002,10 @@ package body Sem_Ch13 is ...@@ -9002,6 +9002,10 @@ package body Sem_Ch13 is
procedure Too_Late is procedure Too_Late is
begin begin
-- Other compilers seem more relaxed about rep items appearing too
-- late. Since analysis tools typically don't care about rep items
-- anyway, no reason to be too strict about this.
if not Relaxed_RM_Semantics then if not Relaxed_RM_Semantics then
Error_Msg_N ("|representation item appears too late!", N); Error_Msg_N ("|representation item appears too late!", N);
end if; end if;
......
gcc/ada/sem_prag.adb
...@@ -1915,7 +1915,9 @@ package body Sem_Prag is ...@@ -1915,7 +1915,9 @@ package body Sem_Prag is
-- is itself a library-level declaration is done elsewhere. -- is itself a library-level declaration is done elsewhere.
-- Note: we omit this check in Relaxed_RM_Semantics mode to properly -- Note: we omit this check in Relaxed_RM_Semantics mode to properly
-- handle code prior to AI-0033. -- handle code prior to AI-0033. Analysis tools typically are not
-- interested in this pragma in any case, so no need to worry too
-- much about its placement.
if Inside_A_Generic then if Inside_A_Generic then
if Ekind (Scope (Current_Scope)) = E_Generic_Package if Ekind (Scope (Current_Scope)) = E_Generic_Package
......
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