[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
This commit is contained in:
Arnaud Charlet 2013-04-11 11:49:40 +02:00
parent 303fbb20de
commit 5b75bf576f
11 changed files with 83 additions and 51 deletions

View File

@ -1,3 +1,16 @@
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>
* debug.adb, sem_prag.adb, par-ch2.adb, sem_attr.adb, gnat1drv.adb,

View File

@ -609,10 +609,6 @@ package body Debug is
-- will only generate Why code for package Standard. Any given input
-- 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
-- done in parallel to speed processing. This switch disables this
-- behavior.

View File

@ -6630,9 +6630,10 @@ package body Exp_Dist is
Make_Simple_Return_Statement (Loc,
Expression =>
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 (
New_Occurrence_Of (RTE (RE_TC_Object), Loc),
New_Occurrence_Of (RTE (RE_Tk_Objref), Loc),
Make_Aggregate (Loc,
Expressions =>
New_List (
@ -10207,11 +10208,11 @@ package body Exp_Dist is
function Make_Constructed_TypeCode
(Kind : Entity_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);
-- Make a return statement that calls TC_Build with the given
-- typecode kind, and the constructed parameters list.
-- Make a return statement that calls Build_Complex_TC with the
-- given typecode kind, and the constructed parameters list.
procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id);
-- Return a typecode that is a TC_Alias for the given typecode
@ -10285,7 +10286,7 @@ package body Exp_Dist is
procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id) is
begin
Add_TypeCode_Parameter (Base_TypeCode, Parameters);
Return_Constructed_TypeCode (RTE (RE_TC_Alias));
Return_Constructed_TypeCode (RTE (RE_Tk_Alias));
end Return_Alias_TypeCode;
-------------------------------
@ -10299,7 +10300,7 @@ package body Exp_Dist is
Constructed_TC : constant Node_Id :=
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_TC_Build), Loc),
New_Occurrence_Of (RTE (RE_Build_Complex_TC), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Kind, Loc),
Make_Aggregate (Loc,
@ -10420,7 +10421,7 @@ package body Exp_Dist is
Add_TypeCode_Parameter
(Make_Constructed_TypeCode
(RTE (RE_TC_Struct), Struct_TC_Params),
(RTE (RE_Tk_Struct), Struct_TC_Params),
Union_TC_Params);
Add_String_Parameter (Name_Str, Union_TC_Params);
@ -10439,7 +10440,7 @@ package body Exp_Dist is
Add_TypeCode_Parameter
(Make_Constructed_TypeCode
(RTE (RE_TC_Union), Union_TC_Params),
(RTE (RE_Tk_Union), Union_TC_Params),
Params);
Add_String_Parameter (Name_Str, Params);
@ -10687,7 +10688,7 @@ package body Exp_Dist is
TC_Append_Record_Traversal
(Parameters, Component_List (Rdef),
Empty, Dummy_Counter);
Return_Constructed_TypeCode (RTE (RE_TC_Struct));
Return_Constructed_TypeCode (RTE (RE_Tk_Struct));
end;
end if;
@ -10705,7 +10706,7 @@ package body Exp_Dist is
for J in 1 .. Ndim loop
if Constrained then
Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Array), New_List (
(RTE (RE_Tk_Array), New_List (
Build_To_Any_Call (Loc,
OK_Convert_To (RTE (RE_Unsigned_32),
Make_Attribute_Reference (Loc,
@ -10731,7 +10732,7 @@ package body Exp_Dist is
Next_Index (Indx);
Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Sequence), New_List (
(RTE (RE_Tk_Sequence), New_List (
Build_To_Any_Call (Loc,
OK_Convert_To (RTE (RE_Unsigned_32),
Make_Integer_Literal (Loc, 0)),
@ -10747,7 +10748,7 @@ package body Exp_Dist is
Start_String;
Store_String_Char ('V');
Add_String_Parameter (End_String, Parameters);
Return_Constructed_TypeCode (RTE (RE_TC_Struct));
Return_Constructed_TypeCode (RTE (RE_Tk_Struct));
end if;
end;

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -35,7 +35,7 @@ package Exp_Dist is
PCS_Version_Number : constant array (PCS_Names) of Int :=
(Name_No_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
-- compiler used to generate distribution stubs and the PCS implementation.
-- It must be incremented whenever a change is made to the generated code

View File

@ -275,7 +275,11 @@ procedure Gnat1drv is
Force_ALI_Tree_File := 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;
end if;

View File

@ -1191,7 +1191,12 @@ package Opt is
Relaxed_RM_Semantics : Boolean := False;
-- GNAT
-- 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;
-- GNATPREP

View File

@ -1048,31 +1048,34 @@ package body Prj.Makr is
Project_File_Extension;
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
and then not Opt.No_Backup
and then
Is_Regular_File (Path_Name (1 .. Path_Last))
and then Is_Regular_File (Path_Name (1 .. Path_Last))
then
declare
Discard : Boolean;
Discard : Boolean;
Saved_Path : constant String :=
Path_Name (1 .. Path_Last) & ".saved_";
Nmb : Natural := 0;
Path_Name (1 .. Path_Last) & ".saved_";
Nmb : Natural;
begin
Nmb := 0;
loop
declare
Img : constant String := Nmb'Img;
begin
if not Is_Regular_File
(Saved_Path & Img (2 .. Img'Last))
(Saved_Path & Img (2 .. Img'Last))
then
Copy_File
(Name => Path_Name (1 .. Path_Last),
(Name => Path_Name (1 .. Path_Last),
Pathname => Saved_Path & Img (2 .. Img'Last),
Mode => Overwrite,
Success => Discard);
Mode => Overwrite,
Success => Discard);
exit;
end if;

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1307,6 +1307,9 @@ package Rtsfind is
RE_Release_Buffer, -- System.Partition_Interface
RE_BS_To_Any, -- 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_B, -- System.Partition_Interface
@ -1350,10 +1353,6 @@ package Rtsfind is
RE_TA_Std_String, -- 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_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface
@ -1373,12 +1372,14 @@ package Rtsfind is
RE_TC_Opaque, -- System.Partition_Interface
RE_TC_WC, -- 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_Struct, -- System.Partition_Interface
RE_TC_Union, -- System.Partition_Interface
RE_TC_Object, -- System.Partition_Interface
RE_Tk_Alias, -- 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_Is2, -- System.Scalar_Values
@ -2550,6 +2551,9 @@ package Rtsfind is
RE_Release_Buffer => System_Partition_Interface,
RE_BS_To_Any => 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_B => System_Partition_Interface,
@ -2593,10 +2597,6 @@ package Rtsfind is
RE_TA_Std_String => 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_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface,
@ -2616,12 +2616,14 @@ package Rtsfind is
RE_TC_Opaque => System_Partition_Interface,
RE_TC_WC => 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_Struct => System_Partition_Interface,
RE_TC_Union => System_Partition_Interface,
RE_TC_Object => System_Partition_Interface,
RE_Tk_Alias => 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,

View File

@ -5016,6 +5016,8 @@ package body Sem_Attr is
then
null;
-- Some other compilers allow dubious use of X'???'Size
elsif Relaxed_RM_Semantics
and then Nkind (P) = N_Attribute_Reference
then

View File

@ -9002,6 +9002,10 @@ package body Sem_Ch13 is
procedure Too_Late is
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
Error_Msg_N ("|representation item appears too late!", N);
end if;

View File

@ -1915,7 +1915,9 @@ package body Sem_Prag is
-- is itself a library-level declaration is done elsewhere.
-- 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 Ekind (Scope (Current_Scope)) = E_Generic_Package