Commit c736294d by Robert Dewar Committed by Arnaud Charlet

exp_disp.adb, [...]: Minor reformatting

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* exp_disp.adb, sem_ch12.adb: Minor reformatting

From-SVN: r160967
parent 22cb89b5
2010-06-18 Robert Dewar <dewar@adacore.com>
* exp_disp.adb, sem_ch12.adb: Minor reformatting
2010-06-18 Ed Schonberg <schonberg@adacore.com> 2010-06-18 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Make_Subtype_From_Expr): If the unconstrained type is * exp_util.adb (Make_Subtype_From_Expr): If the unconstrained type is
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -1546,8 +1546,8 @@ package body Exp_Disp is ...@@ -1546,8 +1546,8 @@ package body Exp_Disp is
Ftyp := Base_Type (Etype (Target_Formal)); Ftyp := Base_Type (Etype (Target_Formal));
end if; end if;
-- For concurrent types, the relevant info is on the corresponding_ -- For concurrent types, the relevant information is found in the
-- record type. -- Corresponding_Record_Type, rather than the type entity itself.
if Is_Concurrent_Type (Ftyp) then if Is_Concurrent_Type (Ftyp) then
Ftyp := Corresponding_Record_Type (Ftyp); Ftyp := Corresponding_Record_Type (Ftyp);
...@@ -3520,7 +3520,7 @@ package body Exp_Disp is ...@@ -3520,7 +3520,7 @@ package body Exp_Disp is
and then not Is_Frozen (Typ) and then not Is_Frozen (Typ)
then then
Error_Msg_Sloc := Sloc (Subp); Error_Msg_Sloc := Sloc (Subp);
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("declaration must appear after completion of type &", N, Typ); ("declaration must appear after completion of type &", N, Typ);
Error_Msg_NE Error_Msg_NE
("\which is an untagged type in the profile of" ("\which is an untagged type in the profile of"
...@@ -7350,7 +7350,7 @@ package body Exp_Disp is ...@@ -7350,7 +7350,7 @@ package body Exp_Disp is
and then and then
not Is_TSS (Prim, TSS_Stream_Output) not Is_TSS (Prim, TSS_Stream_Output)
then then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("abstract inherited private operation&" & ("abstract inherited private operation&" &
" must be overridden (RM 3.9.3(10))", " must be overridden (RM 3.9.3(10))",
Parent (Typ), Prim); Parent (Typ), Prim);
...@@ -7364,11 +7364,11 @@ package body Exp_Disp is ...@@ -7364,11 +7364,11 @@ package body Exp_Disp is
if Is_Controlled (Typ) then if Is_Controlled (Typ) then
if not Finalized then if not Finalized then
Error_Msg_N Error_Msg_N -- CODEFIX???
("controlled type has no explicit Finalize method?", Typ); ("controlled type has no explicit Finalize method?", Typ);
elsif not Adjusted then elsif not Adjusted then
Error_Msg_N Error_Msg_N -- CODEFIX???
("controlled type has no explicit Adjust method?", Typ); ("controlled type has no explicit Adjust method?", Typ);
end if; end if;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -1144,7 +1144,8 @@ package body Sem_Ch12 is ...@@ -1144,7 +1144,8 @@ package body Sem_Ch12 is
Others_Present := True; Others_Present := True;
if Present (Next (Actual)) then if Present (Next (Actual)) then
Error_Msg_N ("others must be last association", Actual); Error_Msg_N -- CODEFIX???
("others must be last association", Actual);
end if; end if;
-- This subprogram is used both for formal packages and for -- This subprogram is used both for formal packages and for
...@@ -1834,11 +1835,11 @@ package body Sem_Ch12 is ...@@ -1834,11 +1835,11 @@ package body Sem_Ch12 is
if Null_Exclusion_Present (N) then if Null_Exclusion_Present (N) then
if not Is_Access_Type (T) then if not Is_Access_Type (T) then
Error_Msg_N Error_Msg_N -- CODEFIX???
("null exclusion can only apply to an access type", N); ("null exclusion can only apply to an access type", N);
elsif Can_Never_Be_Null (T) then elsif Can_Never_Be_Null (T) then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("`NOT NULL` not allowed (& already excludes null)", ("`NOT NULL` not allowed (& already excludes null)",
N, T); N, T);
end if; end if;
...@@ -4088,7 +4089,7 @@ package body Sem_Ch12 is ...@@ -4088,7 +4089,7 @@ package body Sem_Ch12 is
and then Ekind (Gen_Unit) /= E_Generic_Procedure and then Ekind (Gen_Unit) /= E_Generic_Procedure
then then
if Ekind (Gen_Unit) = E_Generic_Function then if Ekind (Gen_Unit) = E_Generic_Function then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot instantiate generic function as procedure", Gen_Id); ("cannot instantiate generic function as procedure", Gen_Id);
else else
Error_Msg_N Error_Msg_N
...@@ -4099,7 +4100,7 @@ package body Sem_Ch12 is ...@@ -4099,7 +4100,7 @@ package body Sem_Ch12 is
and then Ekind (Gen_Unit) /= E_Generic_Function and then Ekind (Gen_Unit) /= E_Generic_Function
then then
if Ekind (Gen_Unit) = E_Generic_Procedure then if Ekind (Gen_Unit) = E_Generic_Procedure then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot instantiate generic procedure as function", Gen_Id); ("cannot instantiate generic procedure as function", Gen_Id);
else else
Error_Msg_N Error_Msg_N
...@@ -4227,7 +4228,8 @@ package body Sem_Ch12 is ...@@ -4227,7 +4228,8 @@ package body Sem_Ch12 is
then then
Error_Msg_NE ("access parameter& is controlling,", Error_Msg_NE ("access parameter& is controlling,",
N, Formal); N, Formal);
Error_Msg_NE ("\corresponding parameter of & must be" Error_Msg_NE -- CODEFIX???
("\corresponding parameter of & must be"
& " explicitly null-excluding", N, Gen_Id); & " explicitly null-excluding", N, Gen_Id);
end if; end if;
...@@ -5043,7 +5045,7 @@ package body Sem_Ch12 is ...@@ -5043,7 +5045,7 @@ package body Sem_Ch12 is
if Is_Child_Unit (E) if Is_Child_Unit (E)
and then not Is_Visible_Child_Unit (E) and then not Is_Visible_Child_Unit (E)
then then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("generic child unit& is not visible", Gen_Id, E); ("generic child unit& is not visible", Gen_Id, E);
end if; end if;
...@@ -8354,14 +8356,14 @@ package body Sem_Ch12 is ...@@ -8354,14 +8356,14 @@ package body Sem_Ch12 is
if Is_Atomic_Object (Actual) if Is_Atomic_Object (Actual)
and then not Is_Atomic (Orig_Ftyp) and then not Is_Atomic (Orig_Ftyp)
then then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot instantiate non-atomic formal object " & ("cannot instantiate non-atomic formal object " &
"with atomic actual", Actual); "with atomic actual", Actual);
elsif Is_Volatile_Object (Actual) elsif Is_Volatile_Object (Actual)
and then not Is_Volatile (Orig_Ftyp) and then not Is_Volatile (Orig_Ftyp)
then then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot instantiate non-volatile formal object " & ("cannot instantiate non-volatile formal object " &
"with volatile actual", Actual); "with volatile actual", Actual);
end if; end if;
...@@ -8528,7 +8530,7 @@ package body Sem_Ch12 is ...@@ -8528,7 +8530,7 @@ package body Sem_Ch12 is
and then Has_Null_Exclusion (Analyzed_Formal) and then Has_Null_Exclusion (Analyzed_Formal)
then then
Error_Msg_Sloc := Sloc (Analyzed_Formal); Error_Msg_Sloc := Sloc (Analyzed_Formal);
Error_Msg_N Error_Msg_N -- CODEFIX???
("actual must exclude null to match generic formal#", Actual); ("actual must exclude null to match generic formal#", Actual);
end if; end if;
...@@ -9212,21 +9214,23 @@ package body Sem_Ch12 is ...@@ -9212,21 +9214,23 @@ package body Sem_Ch12 is
if Is_Access_Constant (A_Gen_T) then if Is_Access_Constant (A_Gen_T) then
if not Is_Access_Constant (Act_T) then if not Is_Access_Constant (Act_T) then
Error_Msg_N Error_Msg_N -- CODEFIX???
("actual type must be access-to-constant type", Actual); ("actual type must be access-to-constant type", Actual);
Abandon_Instantiation (Actual); Abandon_Instantiation (Actual);
end if; end if;
else else
if Is_Access_Constant (Act_T) then if Is_Access_Constant (Act_T) then
Error_Msg_N Error_Msg_N -- CODEFIX???
("actual type must be access-to-variable type", Actual); ("actual type must be access-to-variable type", Actual);
Abandon_Instantiation (Actual); Abandon_Instantiation (Actual);
elsif Ekind (A_Gen_T) = E_General_Access_Type elsif Ekind (A_Gen_T) = E_General_Access_Type
and then Ekind (Base_Type (Act_T)) /= E_General_Access_Type and then Ekind (Base_Type (Act_T)) /= E_General_Access_Type
then then
Error_Msg_N ("actual must be general access type!", Actual); Error_Msg_N -- CODEFIX
Error_Msg_NE ("add ALL to }!", Actual, Act_T); ("actual must be general access type!", Actual);
Error_Msg_NE -- CODEFIX
("add ALL to }!", Actual, Act_T);
Abandon_Instantiation (Actual); Abandon_Instantiation (Actual);
end if; end if;
end if; end if;
...@@ -9266,7 +9270,7 @@ package body Sem_Ch12 is ...@@ -9266,7 +9270,7 @@ package body Sem_Ch12 is
-- Ada 2005: null-exclusion indicators of the two types must agree -- Ada 2005: null-exclusion indicators of the two types must agree
if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("non null exclusion of actual and formal & do not match", ("non null exclusion of actual and formal & do not match",
Actual, Gen_T); Actual, Gen_T);
end if; end if;
...@@ -9388,7 +9392,7 @@ package body Sem_Ch12 is ...@@ -9388,7 +9392,7 @@ package body Sem_Ch12 is
if Has_Aliased_Components (A_Gen_T) if Has_Aliased_Components (A_Gen_T)
and then not Has_Aliased_Components (Act_T) and then not Has_Aliased_Components (Act_T)
then then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("actual must have aliased components to match formal type &", ("actual must have aliased components to match formal type &",
Actual, Gen_T); Actual, Gen_T);
end if; end if;
...@@ -9577,7 +9581,7 @@ package body Sem_Ch12 is ...@@ -9577,7 +9581,7 @@ package body Sem_Ch12 is
-- Perform atomic/volatile checks (RM C.6(12)) -- Perform atomic/volatile checks (RM C.6(12))
if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot have atomic actual type for non-atomic formal type", ("cannot have atomic actual type for non-atomic formal type",
Actual); Actual);
...@@ -9585,7 +9589,7 @@ package body Sem_Ch12 is ...@@ -9585,7 +9589,7 @@ package body Sem_Ch12 is
and then not Is_Volatile (Ancestor) and then not Is_Volatile (Ancestor)
and then Is_By_Reference_Type (Ancestor) and then Is_By_Reference_Type (Ancestor)
then then
Error_Msg_N Error_Msg_N -- CODEFIX???
("cannot have volatile actual type for non-volatile formal type", ("cannot have volatile actual type for non-volatile formal type",
Actual); Actual);
end if; end if;
...@@ -9940,7 +9944,7 @@ package body Sem_Ch12 is ...@@ -9940,7 +9944,7 @@ package body Sem_Ch12 is
and then not Is_Limited_Type (A_Gen_T) and then not Is_Limited_Type (A_Gen_T)
and then False and then False
then then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("actual for non-limited & cannot be a limited type", Actual, ("actual for non-limited & cannot be a limited type", Actual,
Gen_T); Gen_T);
Explain_Limited_Type (Act_T, Actual); Explain_Limited_Type (Act_T, Actual);
...@@ -9988,7 +9992,7 @@ package body Sem_Ch12 is ...@@ -9988,7 +9992,7 @@ package body Sem_Ch12 is
if Is_Limited_Type (Act_T) if Is_Limited_Type (Act_T)
and then not Is_Limited_Type (A_Gen_T) and then not Is_Limited_Type (A_Gen_T)
then then
Error_Msg_NE Error_Msg_NE -- CODEFIX???
("actual for non-limited & cannot be a limited type", Actual, ("actual for non-limited & cannot be a limited type", Actual,
Gen_T); Gen_T);
Explain_Limited_Type (Act_T, Actual); Explain_Limited_Type (Act_T, Actual);
...@@ -12207,11 +12211,11 @@ package body Sem_Ch12 is ...@@ -12207,11 +12211,11 @@ package body Sem_Ch12 is
-- idea to have this flag set properly. -- idea to have this flag set properly.
if Nkind (N) = N_Pragma if Nkind (N) = N_Pragma
and then and then
(Pragma_Name (N) = Name_Assert (Pragma_Name (N) = Name_Assert or else
or else Pragma_Name (N) = Name_Check Pragma_Name (N) = Name_Check or else
or else Pragma_Name (N) = Name_Precondition Pragma_Name (N) = Name_Precondition or else
or else Pragma_Name (N) = Name_Postcondition) Pragma_Name (N) = Name_Postcondition)
and then Present (Associated_Node (Pragma_Identifier (N))) and then Present (Associated_Node (Pragma_Identifier (N)))
then then
Set_Pragma_Enabled (N, Set_Pragma_Enabled (N,
...@@ -12300,19 +12304,22 @@ package body Sem_Ch12 is ...@@ -12300,19 +12304,22 @@ package body Sem_Ch12 is
Act_Unit : Entity_Id) Act_Unit : Entity_Id)
is is
begin begin
-- Regardless of the current mode, predefined units are analyzed in -- Regardless of the current mode, predefined units are analyzed in the
-- the most current Ada mode, and earlier version Ada checks do not -- most current Ada mode, and earlier version Ada checks do not apply
-- apply to predefined units. Nothing needs to be done for non-internal -- to predefined units. Nothing needs to be done for non-internal units.
-- units. These are always analyzed in the current mode. -- These are always analyzed in the current mode.
if Is_Internal_File_Name if Is_Internal_File_Name
(Fname => Unit_File_Name (Get_Source_Unit (Gen_Unit)), (Fname => Unit_File_Name (Get_Source_Unit (Gen_Unit)),
Renamings_Included => True) Renamings_Included => True)
then then
Set_Opt_Config_Switches (True, Current_Sem_Unit = Main_Unit); Set_Opt_Config_Switches (True, Current_Sem_Unit = Main_Unit);
end if; end if;
Current_Instantiated_Parent := (Gen_Unit, Act_Unit, Assoc_Null); Current_Instantiated_Parent :=
(Gen_Id => Gen_Unit,
Act_Id => Act_Unit,
Next_In_HTable => Assoc_Null);
end Set_Instance_Env; end Set_Instance_Env;
----------------- -----------------
......
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