[multiple changes]

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb: Minor change of Indices to Indexes (preferred
	terminology in compiler).

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* scans.ads: Remove Tok_Raise from Sterm, Eterm, After_SM
	categories, now that Ada 95 supports raise expressions.

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Enumeration_Type): Use new target parameter
	Short_Enums_On_Target.
	* sem_ch13.adb (Set_Enum_Esize): Take Short_Enums_On_Target
	into account.
	* targparm.ads, targparm.adb: Add new target parameter Short_Enums.

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): If subtype
	indication is given explicity, check that it matches the array
	component type or the container element type of the domain
	of iteration.

2014-01-24  Tristan Gingold  <gingold@adacore.com>

	* back_end.adb (Scan_Compiler_Arguments): Set Short_Enums_On_Target.

2014-01-24  Vincent Celier  <celier@adacore.com>

	* prj-env.adb (Ada_Objects_Path): Use Ada_Objects_Path_No_Libs
	to cache the result when Including_Libraries is False.
	* prj-env.ads (Ada_Objects_Path): Update documentation
	* prj.adb (Free (Project_Id)): Also free Ada_Objects_Path_No_Libs
	(Get_Object_Directory): Return the Library_Ali_Dir only when
	when Including_Libraries is True.
	* prj.ads (Get_Object_Directory): Fix and complete documentation
	(Project_Data): New component Ada_Objects_Path_No_Libs

From-SVN: r207036
This commit is contained in:
Arnaud Charlet 2014-01-24 15:47:12 +01:00
parent 162c21d998
commit d0ef792107
15 changed files with 193 additions and 41 deletions

View File

@ -1,3 +1,43 @@
2014-01-24 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb: Minor change of Indices to Indexes (preferred
terminology in compiler).
2014-01-24 Robert Dewar <dewar@adacore.com>
* scans.ads: Remove Tok_Raise from Sterm, Eterm, After_SM
categories, now that Ada 95 supports raise expressions.
2014-01-24 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Enumeration_Type): Use new target parameter
Short_Enums_On_Target.
* sem_ch13.adb (Set_Enum_Esize): Take Short_Enums_On_Target
into account.
* targparm.ads, targparm.adb: Add new target parameter Short_Enums.
2014-01-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): If subtype
indication is given explicity, check that it matches the array
component type or the container element type of the domain
of iteration.
2014-01-24 Tristan Gingold <gingold@adacore.com>
* back_end.adb (Scan_Compiler_Arguments): Set Short_Enums_On_Target.
2014-01-24 Vincent Celier <celier@adacore.com>
* prj-env.adb (Ada_Objects_Path): Use Ada_Objects_Path_No_Libs
to cache the result when Including_Libraries is False.
* prj-env.ads (Ada_Objects_Path): Update documentation
* prj.adb (Free (Project_Id)): Also free Ada_Objects_Path_No_Libs
(Get_Object_Directory): Return the Library_Ali_Dir only when
when Including_Libraries is True.
* prj.ads (Get_Object_Directory): Fix and complete documentation
(Project_Data): New component Ada_Objects_Path_No_Libs
2014-01-24 Robert Dewar <dewar@adacore.com>
* checks.adb (Expr_Known_Valid): Result of fpt operator never

View File

@ -40,6 +40,7 @@ with Switch; use Switch;
with Switch.C; use Switch.C;
with System; use System;
with Types; use Types;
with Targparm;
with System.OS_Lib; use System.OS_Lib;
@ -53,6 +54,10 @@ package body Back_End is
pragma Import (C, flag_stack_check);
-- Indicates if stack checking is enabled, imported from misc.c
flag_short_enums : Int;
pragma Import (C, flag_short_enums);
-- Indicates if C enumerations are packed, imported from misc.c
save_argc : Nat;
pragma Import (C, save_argc);
-- Saved value of argc (number of arguments), imported from misc.c
@ -262,6 +267,10 @@ package body Back_End is
Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
-- Acquire short enums flag directly from GCC
Targparm.Short_Enums_On_Target := (flag_short_enums /= 0);
-- Put the arguments in Args
for Arg in Pos range 1 .. save_argc - 1 loop

View File

@ -5157,14 +5157,14 @@ package body Exp_Ch7 is
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
procedure Build_Indices;
-- Generate the indices used in the dimension loops
procedure Build_Indexes;
-- Generate the indexes used in the dimension loops
-------------------
-- Build_Indices --
-- Build_Indexes --
-------------------
procedure Build_Indices is
procedure Build_Indexes is
begin
-- Generate the following identifiers:
-- Jnn - for initialization
@ -5173,14 +5173,14 @@ package body Exp_Ch7 is
Append_To (Index_List,
Make_Defining_Identifier (Loc, New_External_Name ('J', Dim)));
end loop;
end Build_Indices;
end Build_Indexes;
-- Start of processing for Build_Adjust_Or_Finalize_Statements
begin
Finalizer_Decls := New_List;
Build_Indices;
Build_Indexes;
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Comp_Ref :=
@ -5335,8 +5335,8 @@ package body Exp_Ch7 is
function Build_Finalization_Call return Node_Id;
-- Generate a deep finalization call for an array element
procedure Build_Indices;
-- Generate the initialization and finalization indices used in the
procedure Build_Indexes;
-- Generate the initialization and finalization indexes used in the
-- dimension loops.
function Build_Initialization_Call return Node_Id;
@ -5411,10 +5411,10 @@ package body Exp_Ch7 is
end Build_Finalization_Call;
-------------------
-- Build_Indices --
-- Build_Indexes --
-------------------
procedure Build_Indices is
procedure Build_Indexes is
begin
-- Generate the following identifiers:
-- Jnn - for initialization
@ -5427,7 +5427,7 @@ package body Exp_Ch7 is
Append_To (Final_List,
Make_Defining_Identifier (Loc, New_External_Name ('F', Dim)));
end loop;
end Build_Indices;
end Build_Indexes;
-------------------------------
-- Build_Initialization_Call --
@ -5454,7 +5454,7 @@ package body Exp_Ch7 is
Counter_Id := Make_Temporary (Loc, 'C');
Finalizer_Decls := New_List;
Build_Indices;
Build_Indexes;
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-- Generate the block which houses the finalization call, the index

View File

@ -5275,10 +5275,16 @@ package body Freeze is
and then not Has_Size_Clause (Typ)
and then not Has_Size_Clause (Base_Type (Typ))
and then Esize (Typ) < Standard_Integer_Size
-- Don't do this if Short_Enums on target
and then not Short_Enums_On_Target
then
Init_Esize (Typ, Standard_Integer_Size);
Set_Alignment (Typ, Alignment (Standard_Integer));
-- Normal Ada case or size clause present or not Long_C_Enums on target
else
-- If the enumeration type interfaces to C, and it has a size clause
-- that specifies less than int size, it warrants a warning. The
@ -5292,6 +5298,10 @@ package body Freeze is
and then Esize (Typ) /= Esize (Standard_Integer)
and then not Is_Boolean_Type (Typ)
and then not Is_Character_Type (Typ)
-- Don't do this if Short_Enums on target
and then not Short_Enums_On_Target
then
Error_Msg_N
("C enum types have the size of a C int??", Size_Clause (Typ));

View File

@ -219,21 +219,37 @@ package body Prj.Env is
Dummy : Boolean := False;
Result : String_Access;
-- Start of processing for Ada_Objects_Path
begin
-- If it is the first time we call this function for
-- this project, compute the objects path
if Project.Ada_Objects_Path = null then
if Including_Libraries and then Project.Ada_Objects_Path /= null then
return Project.Ada_Objects_Path;
elsif not Including_Libraries
and then Project.Ada_Objects_Path_No_Libs /= null
then
return Project.Ada_Objects_Path_No_Libs;
else
Buffer := new String (1 .. 4096);
For_All_Projects (Project, In_Tree, Dummy);
Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last));
Result := new String'(Buffer (1 .. Buffer_Last));
Free (Buffer);
end if;
return Project.Ada_Objects_Path;
if Including_Libraries then
Project.Ada_Objects_Path := Result;
else
Project.Ada_Objects_Path_No_Libs := Result;
end if;
return Result;
end if;
end Ada_Objects_Path;
-------------------

View File

@ -90,9 +90,12 @@ package Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
-- it and cache it. When Including_Libraries is False, do not include the
-- object directories of the library projects, and do not cache the result.
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call with the
-- exact same parameters, compute it and cache it. When Including_Libraries
-- is False, the object directory of a library project is replaced with the
-- library ALI directory of this project (usually the library directory of
-- the project, except when attribute Library_ALI_Dir is declared) except
-- when the library ALI directory does not contain any ALI file.
procedure Set_Ada_Paths
(Project : Project_Id;

View File

@ -1105,6 +1105,7 @@ package body Prj is
Free (Project.Ada_Include_Path);
Free (Project.Objects_Path);
Free (Project.Ada_Objects_Path);
Free (Project.Ada_Objects_Path_No_Libs);
Free_List (Project.Imported_Projects, Free_Project => False);
Free_List (Project.All_Imported_Projects, Free_Project => False);
Free_List (Project.Languages);
@ -1485,7 +1486,10 @@ package body Prj is
if Project.Library then
if Project.Object_Directory = No_Path_Information
or else Contains_ALI_Files (Project.Library_ALI_Dir.Display_Name)
or else
(Including_Libraries
and then
Contains_ALI_Files (Project.Library_ALI_Dir.Display_Name))
then
return Project.Library_ALI_Dir.Display_Name;
else

View File

@ -973,11 +973,12 @@ package Prj is
Only_If_Ada : Boolean := False) return Path_Name_Type;
-- Return the object directory to use for the project. This depends on
-- whether we have a library project or a standard project. This function
-- might return No_Name when no directory applies.
-- If we have a library project file and Including_Libraries is True then
-- the library dir is returned instead of the object dir.
-- If Only_If_Ada is True, then No_Name will be returned when the project
-- doesn't Ada sources.
-- might return No_Name when no directory applies. If the project is a
-- library project file and Including_Libraries is True then the library
-- ALI dir is returned instead of the object dir, except when there is no
-- ALI files in the Library ALI dir and the object directory exists. If
-- Only_If_Ada is True, then No_Name is returned when the project doesn't
-- include any Ada source.
procedure Compute_All_Imported_Projects
(Root_Project : Project_Id;
@ -1400,9 +1401,14 @@ package Prj is
-------------------
Ada_Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file. Do not
-- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead.
-- The cached value of ADA_OBJECTS_PATH for this project file, with
-- library ALI directories for library projects instead of object
-- directories. Do not use this field directly outside of the
-- compiler, use Prj.Env.Ada_Objects_Path instead.
Ada_Objects_Path_No_Libs : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file with all
-- object directories (no library ALI dir for library projects).
Libgnarl_Needed : Yes_No_Unknown := Unknown;
-- Set to True when libgnarl is needed to link

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- --
@ -82,6 +82,15 @@ package Scans is
Tok_Others, -- OTHERS
Tok_Null, -- NULL
-- Note: Tok_Raise is in no categories now, it used to be Cterm, Eterm,
-- After_SM, but now that Ada 2012 has added raise expressions, the
-- raise token can appear anywhere. Note in particular that Tok_Raise
-- being in Eterm stopped the parser from recognizing "return raise
-- exception-name". This degrades error recovery slightly, and perhaps
-- we could do better, but not worth the effort.
Tok_Raise, -- RAISE
Tok_Dot, -- . Namext
Tok_Apostrophe, -- ' Namext
@ -148,7 +157,6 @@ package Scans is
Tok_Goto, -- GOTO Eterm, Sterm, After_SM
Tok_If, -- IF Eterm, Sterm, After_SM
Tok_Pragma, -- PRAGMA Eterm, Sterm, After_SM
Tok_Raise, -- RAISE Eterm, Sterm, After_SM
Tok_Requeue, -- REQUEUE Eterm, Sterm, After_SM
Tok_Return, -- RETURN Eterm, Sterm, After_SM
Tok_Select, -- SELECT Eterm, Sterm, After_SM

View File

@ -6109,23 +6109,25 @@ package body Sem_Attr is
-- dimensional array.
Index_Type := First_Index (P_Type);
Index := First (Choices (Assoc));
while Present (Index) loop
if Nkind (Index) = N_Range then
Analyze_And_Resolve (
Low_Bound (Index), Etype (Index_Type));
Analyze_And_Resolve (
High_Bound (Index), Etype (Index_Type));
Analyze_And_Resolve
(Low_Bound (Index), Etype (Index_Type));
Analyze_And_Resolve
(High_Bound (Index), Etype (Index_Type));
else
Analyze_And_Resolve (Index, Etype (Index_Type));
end if;
Next (Index);
end loop;
else
-- Choice is a sequence of indices for each dimension
-- Choice is a sequence of indexes for each dimension
else
Index_Type := First_Index (P_Type);
Index := First (Expressions (First (Choices (Assoc))));
while Present (Index_Type)
@ -6137,8 +6139,8 @@ package body Sem_Attr is
end loop;
if Present (Index) or else Present (Index_Type) then
Error_Msg_N (
"dimension mismatch in index list", Assoc);
Error_Msg_N
("dimension mismatch in index list", Assoc);
end if;
end if;
end;

View File

@ -10790,6 +10790,10 @@ package body Sem_Ch13 is
if Has_Foreign_Convention (T)
and then Esize (T) < Standard_Integer_Size
-- Don't do this if Short_Enums on target
and then not Short_Enums_On_Target
then
Init_Esize (T, Standard_Integer_Size);
else

View File

@ -9686,7 +9686,7 @@ package body Sem_Ch3 is
then
-- If an inherited subprogram is implemented by a protected
-- procedure or an entry, then the first parameter of the
-- inherited subprogram shall be of mode out or in out, or
-- inherited subprogram shall be of mode OUT or IN OUT, or
-- an access-to-variable parameter (RM 9.4(11.9/3))
if Is_Protected_Type (Corresponding_Concurrent_Type (T))

View File

@ -1680,12 +1680,21 @@ package body Sem_Ch5 is
Ent : Entity_Id;
Typ : Entity_Id;
Bas : Entity_Id;
begin
Enter_Name (Def_Id);
if Present (Subt) then
Analyze (Subt);
-- Save type of subtype indication for subsequent check.
if Nkind (Subt) = N_Subtype_Indication then
Bas := Entity (Subtype_Mark (Subt));
else
Bas := Entity (Subt);
end if;
end if;
Preanalyze_Range (Iter_Name);
@ -1804,6 +1813,13 @@ package body Sem_Ch5 is
if Of_Present (N) then
Set_Etype (Def_Id, Component_Type (Typ));
if Present (Subt)
and then Bas /= Base_Type (Component_Type (Typ))
then
Error_Msg_N
("subtype indication does not match component type", Subt);
end if;
-- Here we have a missing Range attribute
else
@ -1849,6 +1865,17 @@ package body Sem_Ch5 is
else
Set_Etype (Def_Id, Entity (Element));
-- If subtype indication was given, verify that it matches
-- element type of container.
if Present (Subt)
and then Bas /= Base_Type (Etype (Def_Id))
then
Error_Msg_N
("subtype indication does not match element type",
Subt);
end if;
-- If the container has a variable indexing aspect, the
-- element is a variable and is modifiable in the loop.

View File

@ -63,6 +63,7 @@ package body Targparm is
SCD, -- Stack_Check_Default
SCL, -- Stack_Check_Limits
SCP, -- Stack_Check_Probes
SHE, -- Short_Enums
SLS, -- Support_Long_Shifts
SNZ, -- Signed_Zeros
SSL, -- Suppress_Standard_Library
@ -101,6 +102,7 @@ package body Targparm is
SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
SHE_Str : aliased constant Source_Buffer := "Short_Enums";
SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
@ -139,6 +141,7 @@ package body Targparm is
SCD_Str'Access,
SCL_Str'Access,
SCP_Str'Access,
SHE_Str'Access,
SLS_Str'Access,
SNZ_Str'Access,
SSL_Str'Access,
@ -587,6 +590,7 @@ package body Targparm is
when EXS => Exit_Status_Supported_On_Target := Result;
when FEL => Frontend_Layout_On_Target := Result;
when FFO => Fractional_Fixed_Ops_On_Target := Result;
when JVM =>
if Result then
VM_Target := JVM_Target;
@ -608,6 +612,7 @@ package body Targparm is
when SCD => Stack_Check_Default_On_Target := Result;
when SCL => Stack_Check_Limits_On_Target := Result;
when SCP => Stack_Check_Probes_On_Target := Result;
when SHE => Short_Enums_On_Target := Result;
when SLS => Support_Long_Shifts_On_Target := Result;
when SSL => Suppress_Standard_Library_On_Target := Result;
when SNZ => Signed_Zeros_On_Target := Result;

View File

@ -197,7 +197,7 @@ package Targparm is
----------------------------
-- The great majority of GNAT ports are based on GCC. The switches in
-- This section indicate the use of some non-standard target back end
-- this section indicate the use of some non-standard target back end
-- or other special targetting requirements.
AAMP_On_Target : Boolean := False;
@ -605,6 +605,24 @@ package Targparm is
Frontend_Layout_On_Target : Boolean := False;
-- Set True if front end does layout
Short_Enums_On_Target : Boolean := False;
-- In most C ABI's, enumeration types always have int size. If this switch
-- is False, which is the default, that's what the front end implements for
-- enumeration types with a foreign convention (includ C and C++). However
-- on some ABI's (notably the ARM-EABI), enumeration types have sizes that
-- are minimal for the range of values. For such cases this switch is set
-- True (in the appropriate System file), and the front-end uses the normal
-- Ada rules for sizing enumeration types (which correspond to this method
-- of selecting the shortest signed or unsigned integer representation that
-- can accomodate the number of items in the type, or the range of values
-- if an enumeration representation clause is used.
-- the same size as C int, or Ada Integer. That's the most common case, but
-- there are targets (most notably those following the ARM-EABI) where the
-- size for enumeration types is the same as in Ada (i.e. the smallest
-- integer type that accomodates the number of enumeration choices, or the
-- range of values in an enumeration-representation clause). For such cases
-- this switch is set to False in the corresponding System file.
-----------------
-- Subprograms --
-----------------