Commit e8e581cd by Arnaud Charlet

[multiple changes]

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Preanalyze_Range): If the expression, which
	denotes some domain of iteration, has a type with implicit
	dereference, and does not have any iterable aspects, insert
	dereference to obtain proper container type.

2012-12-05  Bob Duff  <duff@adacore.com>

	* par-ch8.adb (P_Use_Type_Clause): Fix the Sloc for "use all type ..."
	to point to "use".

2012-12-05  Arnaud Charlet  <charlet@adacore.com>

	* make.adb (Compile): Always pass -x adascil in CodePeer mode.

From-SVN: r194198
parent 42fc9a7f
2012-12-05 Ed Schonberg <schonberg@adacore.com> 2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Preanalyze_Range): If the expression, which
denotes some domain of iteration, has a type with implicit
dereference, and does not have any iterable aspects, insert
dereference to obtain proper container type.
2012-12-05 Bob Duff <duff@adacore.com>
* par-ch8.adb (P_Use_Type_Clause): Fix the Sloc for "use all type ..."
to point to "use".
2012-12-05 Arnaud Charlet <charlet@adacore.com>
* make.adb (Compile): Always pass -x adascil in CodePeer mode.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* s-rident.ads, restrict.ads: Remove discrepancies between the * s-rident.ads, restrict.ads: Remove discrepancies between the
documentation on implementation-defined restrictions, and documentation on implementation-defined restrictions, and
the internal data structure used for warnings and errors on the internal data structure used for warnings and errors on
......
...@@ -704,6 +704,7 @@ package body Make is ...@@ -704,6 +704,7 @@ package body Make is
Output_Flag : constant String_Access := new String'("-o"); Output_Flag : constant String_Access := new String'("-o");
Ada_Flag_1 : constant String_Access := new String'("-x"); Ada_Flag_1 : constant String_Access := new String'("-x");
Ada_Flag_2 : constant String_Access := new String'("ada"); Ada_Flag_2 : constant String_Access := new String'("ada");
AdaSCIL_Flag : constant String_Access := new String'("adascil");
No_gnat_adc : constant String_Access := new String'("-gnatA"); No_gnat_adc : constant String_Access := new String'("-gnatA");
GNAT_Flag : constant String_Access := new String'("-gnatpg"); GNAT_Flag : constant String_Access := new String'("-gnatpg");
Do_Not_Check_Flag : constant String_Access := new String'("-x"); Do_Not_Check_Flag : constant String_Access := new String'("-x");
...@@ -2989,8 +2990,16 @@ package body Make is ...@@ -2989,8 +2990,16 @@ package body Make is
-- Now check if the file name has one of the suffixes familiar to -- Now check if the file name has one of the suffixes familiar to
-- the gcc driver. If this is not the case then add the ada flag -- the gcc driver. If this is not the case then add the ada flag
-- "-x ada". -- "-x ada".
-- Append systematically "-x adascil" in CodePeer mode instead, to
-- force the use of gnat1scil instead of gnat1.
if not Ada_File_Name (S) and then not Targparm.AAMP_On_Target then if CodePeer_Mode then
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := Ada_Flag_1;
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := AdaSCIL_Flag;
elsif not Ada_File_Name (S) and then not Targparm.AAMP_On_Target then
Comp_Last := Comp_Last + 1; Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := Ada_Flag_1; Comp_Args (Comp_Last) := Ada_Flag_1;
Comp_Last := Comp_Last + 1; Comp_Last := Comp_Last + 1;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, 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- --
...@@ -106,6 +106,7 @@ package body Ch8 is ...@@ -106,6 +106,7 @@ package body Ch8 is
function P_Use_Type_Clause return Node_Id is function P_Use_Type_Clause return Node_Id is
Use_Node : Node_Id; Use_Node : Node_Id;
All_Present : Boolean; All_Present : Boolean;
Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;
begin begin
if Token = Tok_All then if Token = Tok_All then
...@@ -121,7 +122,7 @@ package body Ch8 is ...@@ -121,7 +122,7 @@ package body Ch8 is
All_Present := False; All_Present := False;
end if; end if;
Use_Node := New_Node (N_Use_Type_Clause, Prev_Token_Ptr); Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
Set_All_Present (Use_Node, All_Present); Set_All_Present (Use_Node, All_Present);
Set_Subtype_Marks (Use_Node, New_List); Set_Subtype_Marks (Use_Node, New_List);
Set_Used_Operations (Use_Node, No_Elist); Set_Used_Operations (Use_Node, No_Elist);
......
...@@ -2983,6 +2983,7 @@ package body Sem_Ch5 is ...@@ -2983,6 +2983,7 @@ package body Sem_Ch5 is
procedure Preanalyze_Range (R_Copy : Node_Id) is procedure Preanalyze_Range (R_Copy : Node_Id) is
Save_Analysis : constant Boolean := Full_Analysis; Save_Analysis : constant Boolean := Full_Analysis;
Typ : Entity_Id;
begin begin
Full_Analysis := False; Full_Analysis := False;
...@@ -3043,6 +3044,40 @@ package body Sem_Ch5 is ...@@ -3043,6 +3044,40 @@ package body Sem_Ch5 is
elsif Nkind (R_Copy) in N_Subexpr then elsif Nkind (R_Copy) in N_Subexpr then
Resolve (R_Copy); Resolve (R_Copy);
Typ := Etype (R_Copy);
if Is_Discrete_Type (Typ) then
null;
-- Check that the resulting object is an iterable container.
elsif Present (Find_Aspect (Typ, Aspect_Iterator_Element))
or else Present (Find_Aspect (Typ, Aspect_Constant_Indexing))
or else Present (Find_Aspect (Typ, Aspect_Variable_Indexing))
then
null;
-- The expression may yield an implcit reference to an iterable
-- container. Insert explicit dereference so that proper type is
-- visible in the loop.
elsif Has_Implicit_Dereference (Etype (R_Copy)) then
declare
Disc : Entity_Id;
begin
Disc := First_Discriminant (Typ);
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Build_Explicit_Dereference (R_Copy, Disc);
exit;
end if;
Next_Discriminant (Disc);
end loop;
end;
end if;
end if; end if;
Expander_Mode_Restore; Expander_Mode_Restore;
......
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