Commit 820f1162 by Arnaud Charlet

[multiple changes]

2017-04-25  Bob Duff  <duff@adacore.com>

	* freeze.adb (Freeze_Record_Type): Use the
	underlying type of the component type to determine whether it's
	elementary. For representation clause purposes, a private type
	should behave the same as its full type.
	* fname.ads, fname.adb (Is_Predefined_File_Name):
	Make sure things like "system.ali" are recognized as predefined.

2017-04-25  Javier Miranda  <miranda@adacore.com>

	* debug.adb: Update documentation of -gnatd.6.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Preanalyze_Range): Handle properly an Ada2012
	element iterator when the name is an overloaded function call,
	one of whose interpretations yields an array.

From-SVN: r247155
parent 998429d6
2017-04-25 Bob Duff <duff@adacore.com> 2017-04-25 Bob Duff <duff@adacore.com>
* freeze.adb (Freeze_Record_Type): Use the
underlying type of the component type to determine whether it's
elementary. For representation clause purposes, a private type
should behave the same as its full type.
* fname.ads, fname.adb (Is_Predefined_File_Name):
Make sure things like "system.ali" are recognized as predefined.
2017-04-25 Javier Miranda <miranda@adacore.com>
* debug.adb: Update documentation of -gnatd.6.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Preanalyze_Range): Handle properly an Ada2012
element iterator when the name is an overloaded function call,
one of whose interpretations yields an array.
2017-04-25 Bob Duff <duff@adacore.com>
* uname.ads, uname.adb (Is_Predefined_Unit_Name, * uname.ads, uname.adb (Is_Predefined_Unit_Name,
Is_Internal_Unit_Name): New functions for operating on unit Is_Internal_Unit_Name): New functions for operating on unit
names, as opposed to file names. There's some duplicated code names, as opposed to file names. There's some duplicated code
......
...@@ -160,7 +160,7 @@ package body Debug is ...@@ -160,7 +160,7 @@ package body Debug is
-- d.3 Output debugging information from Exp_Unst -- d.3 Output debugging information from Exp_Unst
-- d.4 Do not delete generated C file in case of errors -- d.4 Do not delete generated C file in case of errors
-- d.5 Do not generate imported subprogram definitions in C code -- d.5 Do not generate imported subprogram definitions in C code
-- d.6 Do not avoid declaring unreferenced itypes in C code -- d.6 Do not avoid declaring unreferenced types in C code
-- d.7 -- d.7
-- d.8 -- d.8
-- d.9 -- d.9
...@@ -781,9 +781,9 @@ package body Debug is ...@@ -781,9 +781,9 @@ package body Debug is
-- This debug flag disables this generation when generating C code, -- This debug flag disables this generation when generating C code,
-- assuming a proper #include will be used instead. -- assuming a proper #include will be used instead.
-- d.6 By default the C back-end avoids declaring itypes that are not -- d.6 By default the C back-end avoids declaring types that are not
-- referenced by the generated C code. This debug flag restores the -- referenced by the generated C code. This debug flag restores the
-- output of all the itypes. -- output of all the types.
------------------------------------------ ------------------------------------------
-- Documentation for Binder Debug Flags -- -- Documentation for Binder Debug Flags --
......
...@@ -134,7 +134,7 @@ package body Fname is ...@@ -134,7 +134,7 @@ package body Fname is
return return
Is_Predefined_File_Name (Fname, Renamings_Included) Is_Predefined_File_Name (Fname, Renamings_Included)
or else Has_Prefix (Fname, Prefix => "g-") or else Has_Prefix (Fname, Prefix => "g-")
or else Has_Prefix (Fname, Prefix => "gnat.ad"); or else Has_Prefix (Fname, Prefix => "gnat.");
end Is_Internal_File_Name; end Is_Internal_File_Name;
function Is_Internal_File_Name function Is_Internal_File_Name
...@@ -174,9 +174,13 @@ package body Fname is ...@@ -174,9 +174,13 @@ package body Fname is
return False; return False;
end if; end if;
if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada -- We include the "." in the prefixes below, so we don't match (e.g.)
or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces -- adamant.ads. So the first line matches "ada.ads", "ada.adb", and
or else Has_Prefix (Fname, Prefix => "system.ad") -- System -- "ada.ali".
if Has_Prefix (Fname, Prefix => "ada.") -- Ada
or else Has_Prefix (Fname, Prefix => "interfac.") -- Interfaces
or else Has_Prefix (Fname, Prefix => "system.") -- System
then then
return True; return True;
end if; end if;
...@@ -190,45 +194,46 @@ package body Fname is ...@@ -190,45 +194,46 @@ package body Fname is
return return
-- Calendar -- Calendar
Has_Prefix (Fname, Prefix => "calendar.ad") Has_Prefix (Fname, Prefix => "calendar.")
-- Machine_Code -- Machine_Code
or else Has_Prefix (Fname, Prefix => "machcode.ad") or else Has_Prefix (Fname, Prefix => "machcode.")
-- Unchecked_Conversion -- Unchecked_Conversion
or else Has_Prefix (Fname, Prefix => "unchconv.ad") or else Has_Prefix (Fname, Prefix => "unchconv.")
-- Unchecked_Deallocation -- Unchecked_Deallocation
or else Has_Prefix (Fname, Prefix => "unchdeal.ad") or else Has_Prefix (Fname, Prefix => "unchdeal.")
-- Direct_IO -- Direct_IO
or else Has_Prefix (Fname, Prefix => "directio.ad") or else Has_Prefix (Fname, Prefix => "directio.")
-- IO_Exceptions -- IO_Exceptions
or else Has_Prefix (Fname, Prefix => "ioexcept.ad") or else Has_Prefix (Fname, Prefix => "ioexcept.")
-- Sequential_IO -- Sequential_IO
or else Has_Prefix (Fname, Prefix => "sequenio.ad") or else Has_Prefix (Fname, Prefix => "sequenio.")
-- Text_IO -- Text_IO
or else Has_Prefix (Fname, Prefix => "text_io.ad"); or else Has_Prefix (Fname, Prefix => "text_io.");
end Is_Predefined_File_Name; end Is_Predefined_File_Name;
function Is_Predefined_File_Name function Is_Predefined_File_Name
(Fname : File_Name_Type; (Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean Renamings_Included : Boolean := True) return Boolean
is is
begin Result : constant Boolean :=
return
Is_Predefined_File_Name Is_Predefined_File_Name
(Get_Name_String (Fname), Renamings_Included); (Get_Name_String (Fname), Renamings_Included);
begin
return Result;
end Is_Predefined_File_Name; end Is_Predefined_File_Name;
--------------- ---------------
......
...@@ -3756,14 +3756,15 @@ package body Freeze is ...@@ -3756,14 +3756,15 @@ package body Freeze is
-- cannot modify the size of alignment of an aliased component. -- cannot modify the size of alignment of an aliased component.
All_Elem_Components : Boolean := True; All_Elem_Components : Boolean := True;
-- Set False if we encounter a component of a composite type -- True if all components are of a type whose underlying type is
-- elementary.
All_Sized_Components : Boolean := True; All_Sized_Components : Boolean := True;
-- Set False if we encounter a component with unknown RM_Size -- True if all components have a known RM_Size
All_Storage_Unit_Components : Boolean := True; All_Storage_Unit_Components : Boolean := True;
-- Set False if we encounter a component of a composite type whose -- True if all components have an RM_Size that is a multiple of the
-- RM_Size is not a multiple of the storage unit. -- storage unit.
Elem_Component_Total_Esize : Uint := Uint_0; Elem_Component_Total_Esize : Uint := Uint_0;
-- Accumulates total Esize values of all elementary components. Used -- Accumulates total Esize values of all elementary components. Used
...@@ -4091,7 +4092,9 @@ package body Freeze is ...@@ -4091,7 +4092,9 @@ package body Freeze is
Sized_Component_Total_RM_Size := Sized_Component_Total_RM_Size :=
Sized_Component_Total_RM_Size + RM_Size (Etype (Comp)); Sized_Component_Total_RM_Size + RM_Size (Etype (Comp));
if Is_Elementary_Type (Etype (Comp)) then if Present (Underlying_Type (Etype (Comp)))
and then Is_Elementary_Type (Underlying_Type (Etype (Comp)))
then
Elem_Component_Total_Esize := Elem_Component_Total_Esize :=
Elem_Component_Total_Esize + Esize (Etype (Comp)); Elem_Component_Total_Esize + Esize (Etype (Comp));
else else
......
...@@ -3811,6 +3811,7 @@ package body Sem_Ch5 is ...@@ -3811,6 +3811,7 @@ package body Sem_Ch5 is
if Nkind (R_Copy) in N_Subexpr and then Is_Overloaded (R_Copy) then if Nkind (R_Copy) in N_Subexpr and then Is_Overloaded (R_Copy) then
-- Apply preference rules for range of predefined integer types, or -- Apply preference rules for range of predefined integer types, or
-- check for array or iterable construct for "of" iterator, or
-- diagnose true ambiguity. -- diagnose true ambiguity.
declare declare
...@@ -3842,6 +3843,24 @@ package body Sem_Ch5 is ...@@ -3842,6 +3843,24 @@ package body Sem_Ch5 is
exit; exit;
end if; end if;
end if; end if;
elsif Nkind (Parent (R_Copy)) = N_Iterator_Specification
and then Of_Present (Parent (R_Copy))
then
if Is_Array_Type (It.Typ)
or else Has_Aspect (It.Typ, Aspect_Iterator_Element)
or else Has_Aspect (It.Typ, Aspect_Constant_Indexing)
or else Has_Aspect (It.Typ, Aspect_Variable_Indexing)
then
if No (Found) then
Found := It.Typ;
Set_Etype (R_Copy, It.Typ);
else
Error_Msg_N
("ambiguous domain of iteration", R_Copy);
end if;
end if;
end if; end if;
Get_Next_Interp (I, It); Get_Next_Interp (I, It);
......
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