+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
with Switch.C; use Switch.C;
with System; use System;
with Types; use Types;
+with Targparm;
with System.OS_Lib; use System.OS_Lib;
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
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
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
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 :=
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;
end Build_Finalization_Call;
-------------------
- -- Build_Indices --
+ -- Build_Indexes --
-------------------
- procedure Build_Indices is
+ procedure Build_Indexes is
begin
-- Generate the following identifiers:
-- Jnn - for initialization
Append_To (Final_List,
Make_Defining_Identifier (Loc, New_External_Name ('F', Dim)));
end loop;
- end Build_Indices;
+ end Build_Indexes;
-------------------------------
-- Build_Initialization_Call --
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
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
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));
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;
-------------------
(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;
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);
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
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;
-------------------
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
-- --
-- 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- --
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
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
-- 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)
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;
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
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))
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);
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
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.
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
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";
SCD_Str'Access,
SCL_Str'Access,
SCP_Str'Access,
+ SHE_Str'Access,
SLS_Str'Access,
SNZ_Str'Access,
SSL_Str'Access,
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;
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;
----------------------------
-- 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;
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 --
-----------------
projects / gcc.git / commitdiff