From: Arnaud Charlet Date: Fri, 12 Apr 2013 12:58:01 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7f18b29a17b0905afb33ab3c0617fc587b766f97;p=gcc.git [multiple changes] 2013-04-12 Robert Dewar * opt.ads (Style_Check_Main): New switch. * sem.adb (Semantics): Set Style_Check flag properly for new unit to be analyzed. * sem_ch10.adb (Analyze_With_Clause): Don't reset Style_Check, the proper setting of this flag is now part of the Semantics procedure. * switch-c.adb (Scan_Front_End_Switches): Set Style_Check_Main for -gnatg and -gnaty 2013-04-12 Doug Rupp * s-crtl.ads (fopen, freopen): Add vms_form parameter * i-cstrea.ads (fopen, freopen): Likewise. * adaint.h (__gnat_fopen, __gnat_freopen): Likewise. * adaint.c (__gnat_fopen, __gnat_freopen): Likewise. [VMS]: Split out RMS keys and call CRTL function appropriately. * s-fileio.adb (Form_VMS_RMS_Keys, Form_RMS_Context_Key): New subprograms. (Open, Reset): Call Form_VMS_RMS_Keys. Call fopen,freopen with vms_form * gnat_rm.texi: Document implemented RMS keys. From-SVN: r197902 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c19dd7fe27a..b4d29f73f55 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2013-04-12 Robert Dewar + + * opt.ads (Style_Check_Main): New switch. + * sem.adb (Semantics): Set Style_Check flag properly for new + unit to be analyzed. + * sem_ch10.adb (Analyze_With_Clause): Don't reset Style_Check, + the proper setting of this flag is now part of the Semantics + procedure. + * switch-c.adb (Scan_Front_End_Switches): Set Style_Check_Main + for -gnatg and -gnaty + +2013-04-12 Doug Rupp + + * s-crtl.ads (fopen, freopen): Add vms_form parameter + * i-cstrea.ads (fopen, freopen): Likewise. + * adaint.h (__gnat_fopen, __gnat_freopen): Likewise. + * adaint.c (__gnat_fopen, __gnat_freopen): Likewise. + [VMS]: Split out RMS keys and call CRTL function appropriately. + * s-fileio.adb (Form_VMS_RMS_Keys, Form_RMS_Context_Key): New + subprograms. + (Open, Reset): Call Form_VMS_RMS_Keys. Call fopen,freopen with + vms_form + * gnat_rm.texi: Document implemented RMS keys. + 2013-04-12 Hristian Kirtchev * sem_ch13.adb (Analyze_Aspect_Specifications): diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index dc94d63d556..c4bb7540c52 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * 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- * @@ -213,6 +213,8 @@ struct vstring #define SYI$_ACTIVECPU_CNT 0x111e extern int LIB$GETSYI (int *, unsigned int *); +extern unsigned int LIB$CALLG_64 + ( unsigned long long argument_list [], int (*user_procedure)(void)); #else #include @@ -820,7 +822,8 @@ __gnat_rmdir (char *path) } FILE * -__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) +__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED, + char *vms_form ATTRIBUTE_UNUSED) { #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -837,7 +840,37 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) return _tfopen (wpath, wmode); #elif defined (VMS) - return decc$fopen (path, mode); + if (vms_form == 0) + return decc$fopen (path, mode); + else + { + char *local_form = (char *) alloca (strlen (vms_form) + 1); + /* Allocate an argument list of guaranteed ample length. */ + unsigned long long *arg_list = + (unsigned long long *) alloca (strlen (vms_form) + 3); + char *ptrb, *ptre; + int i; + + arg_list [1] = (unsigned long long) path; + arg_list [2] = (unsigned long long) mode; + strcpy (local_form, vms_form); + + /* Given a string such as "\"rfm=udf\",\"rat=cr\"" + Split it into an argument list as "rfm=udf","rat=cr". */ + ptrb = local_form; + for (i = 0; *ptrb; i++) + { + ptrb = strchr (ptrb, '"'); + ptre = strchr (ptrb + 1, '"'); + *ptre = 0; + arg_list [i + 3] = (unsigned long long) (ptrb + 1); + ptrb = ptre + 1; + } + arg_list [0] = i + 2; + /* CALLG_64 returns int , fortunately (FILE *) on VMS is a + always a 32bit pointer. */ + return LIB$CALLG_64 (arg_list, &decc$fopen); + } #else return GNAT_FOPEN (path, mode); #endif @@ -847,7 +880,8 @@ FILE * __gnat_freopen (char *path, char *mode, FILE *stream, - int encoding ATTRIBUTE_UNUSED) + int encoding ATTRIBUTE_UNUSED, + char *vms_form ATTRIBUTE_UNUSED) { #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -864,7 +898,38 @@ __gnat_freopen (char *path, return _tfreopen (wpath, wmode, stream); #elif defined (VMS) - return decc$freopen (path, mode, stream); + if (vms_form == 0) + return decc$freopen (path, mode, stream); + else + { + char *local_form = (char *) alloca (strlen (vms_form) + 1); + /* Allocate an argument list of guaranteed ample length. */ + unsigned long long *arg_list = + (unsigned long long *) alloca (strlen (vms_form) + 4); + char *ptrb, *ptre; + int i; + + arg_list [1] = (unsigned long long) path; + arg_list [2] = (unsigned long long) mode; + arg_list [3] = (unsigned long long) stream; + strcpy (local_form, vms_form); + + /* Given a string such as "\"rfm=udf\",\"rat=cr\"" + Split it into an argument list as "rfm=udf","rat=cr". */ + ptrb = local_form; + for (i = 0; *ptrb; i++) + { + ptrb = strchr (ptrb, '"'); + ptre = strchr (ptrb + 1, '"'); + *ptre = 0; + arg_list [i + 4] = (unsigned long long) (ptrb + 1); + ptrb = ptre + 1; + } + arg_list [0] = i + 3; + /* CALLG_64 returns int , fortunately (FILE *) on VMS is a + always a 32bit pointer. */ + return LIB$CALLG_64 (arg_list, &decc$freopen); + } #else return freopen (path, mode, stream); #endif diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 7956e27a709..78af57c9dae 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * 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- * @@ -128,9 +128,10 @@ extern int __gnat_rename (char *, char *); extern int __gnat_chdir (char *); extern int __gnat_rmdir (char *); -extern FILE *__gnat_fopen (char *, char *, int); +extern FILE *__gnat_fopen (char *, char *, int, + char *); extern FILE *__gnat_freopen (char *, char *, FILE *, - int); + int, char *); extern int __gnat_open_read (char *, int); extern int __gnat_open_rw (char *, int); extern int __gnat_open_create (char *, int); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index abdfcce052c..8e94e4e07a7 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -14261,6 +14261,25 @@ The use of these parameters is described later in this section. If an unrecognized keyword appears in a form string, it is silently ignored and not considered invalid. +@noindent +For OpenVMS additional FORM string keywords are available for use with +RMS services. The syntax is: + +@smallexample +VMS_RMS_Keys=(keyword=value,@dots{},keyword=value) +@end smallexample + +@noindent +The following RMS keywords and values are currently defined: + +@smallexample +Context=Force_Stream_Mode|Force_Record_Mode +@end smallexample + +@noindent +VMS RMS keys are silently ignored on non-VMS systems. On OpenVMS +unimplented RMS keywords, values, or invalid syntax will raise Use_Error. + @node Direct_IO @section Direct_IO diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 1a7e76a713b..95dae64361e 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1995-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-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- -- @@ -107,8 +107,8 @@ package Interfaces.C_Streams is function fopen (filename : chars; mode : chars; - encoding : System.CRTL.Filename_Encoding := System.CRTL.UTF8) - return FILEs + encoding : System.CRTL.Filename_Encoding := System.CRTL.UTF8; + vms_form : chars := System.Null_Address) return FILEs renames System.CRTL.fopen; -- Note: to maintain target independence, use text_translation_required, -- a boolean variable defined in sysdep.c to deal with the target @@ -144,8 +144,8 @@ package Interfaces.C_Streams is (filename : chars; mode : chars; stream : FILEs; - encoding : System.CRTL.Filename_Encoding := System.CRTL.UTF8) - return FILEs + encoding : System.CRTL.Filename_Encoding := System.CRTL.UTF8; + vms_form : chars := System.Null_Address) return FILEs renames System.CRTL.freopen; function fseek diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 03580fe117b..b446eea8271 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1267,7 +1267,15 @@ package Opt is -- GNAT -- Set True to perform style checks. Activates checks carried out in -- package Style (see body of this package for details of checks). This - -- flag is set True by either the -gnatg or -gnaty switches. + -- flag is set True by use of either the -gnatg or -gnaty switches, or + -- by the Style_Check pragma. + + Style_Check_Main : Boolean := False; + -- GNAT + -- Set True if Style_Check was set for the main unit. This is used to + -- renable style checks for units in the mail extended source that get + -- with'ed indirectly. It is set on by use of either the -gnatg or -gnaty + -- switches, but not by use of the Style_Checks pragma. Suppress_All_Inlining : Boolean := False; -- GNAT diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index 18c43c42a64..390f47e02df 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -97,7 +97,8 @@ package System.CRTL is function fopen (filename : chars; mode : chars; - encoding : Filename_Encoding := Unspecified) return FILEs; + encoding : Filename_Encoding := Unspecified; + vms_form : chars := System.Null_Address) return FILEs; pragma Import (C, fopen, "__gnat_fopen"); function fputc (C : int; stream : FILEs) return int; @@ -113,7 +114,8 @@ package System.CRTL is (filename : chars; mode : chars; stream : FILEs; - encoding : Filename_Encoding := Unspecified) return FILEs; + encoding : Filename_Encoding := Unspecified; + vms_form : chars := System.Null_Address) return FILEs; pragma Import (C, freopen, "__gnat_freopen"); function fseek diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 88bad49f76e..0eea5367ef4 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -52,6 +52,11 @@ package body System.File_IO is use type Interfaces.C.int; use type CRTL.size_t; + subtype String_Access is System.OS_Lib.String_Access; + procedure Free (X : in out String_Access) renames System.OS_Lib.Free; + function "=" (X, Y : String_Access) return Boolean + renames System.OS_Lib."="; + ---------------------- -- Global Variables -- ---------------------- @@ -98,6 +103,9 @@ package body System.File_IO is (C, text_translation_required, "__gnat_text_translation_required"); -- If true, add appropriate suffix to control string for Open + VMS_Formstr : String_Access := null; + -- For special VMS RMS keywords and values. + ----------------------- -- Local Subprograms -- ----------------------- @@ -132,11 +140,20 @@ package body System.File_IO is -- with Name includes that file name in the message. procedure Raise_Device_Error - (File : AFCB_Ptr; Errno : Integer := OS_Lib.Errno); + (File : AFCB_Ptr; + Errno : Integer := OS_Lib.Errno); pragma No_Return (Raise_Device_Error); -- Clear error indication on File and raise Device_Error with an exception -- message providing errno information. + procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access); + -- Parse the RMS Keys + + function Form_RMS_Context_Key + (Form : String; + VMS_Form : String_Access) return Natural; + -- Parse the RMS Context Key + ---------------- -- Append_Set -- ---------------- @@ -640,6 +657,191 @@ package body System.File_IO is Stop := 0; end Form_Parameter; + -------------------------- + -- Form_RMS_Context_Key -- + -------------------------- + + function Form_RMS_Context_Key + (Form : String; + VMS_Form : String_Access) return Natural + is + type Context_Parms is + (Binary_Data, Convert_Fortran_Carriage_Control, Force_Record_Mode, + Force_Stream_Mode, Explicit_Write); + -- Ada-fied list of all possible Context keyword values. + + Pos : Natural := 0; + Klen : Natural := 0; + Index : Natural; + + begin + -- Find the end of the occupation + + for J in VMS_Form'First .. VMS_Form'Last loop + if VMS_Form (J) = ASCII.NUL then + Pos := J; + exit; + end if; + end loop; + + Index := Form'First; + while Index < Form'Last loop + if Form (Index) = '=' then + Index := Index + 1; + + -- Loop through the context values and look for a match + + for Parm in Context_Parms loop + declare + KImage : String := Context_Parms'Image (Parm); + + begin + Klen := KImage'Length; + To_Lower (KImage); + + if Form (Index .. Index + Klen - 1) = KImage then + case Parm is + when Force_Record_Mode => + VMS_Form (Pos) := '"'; + Pos := Pos + 1; + VMS_Form (Pos .. Pos + 7) := "ctx=rec"; + Pos := Pos + 7; + VMS_Form (Pos) := '"'; + Pos := Pos + 1; + VMS_Form (Pos) := ','; + return Index + Klen; + + when Force_Stream_Mode => + VMS_Form (Pos) := '"'; + Pos := Pos + 1; + VMS_Form (Pos .. Pos + 7) := "ctx=stm"; + Pos := Pos + 7; + VMS_Form (Pos) := '"'; + Pos := Pos + 1; + VMS_Form (Pos) := ','; + return Index + Klen; + + when others => + raise Use_Error + with "unimplemented RMS Context Value"; + end case; + end if; + end; + end loop; + + raise Use_Error with "unrecognized RMS Context Value"; + end if; + end loop; + + raise Use_Error with "malformed RMS Context Value"; + end Form_RMS_Context_Key; + + ----------------------- + -- Form_VMS_RMS_Keys -- + ----------------------- + + procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access) + is + VMS_RMS_Keys_Token : constant String := "vms_rms_keys"; + Klen : Natural := VMS_RMS_Keys_Token'Length; + Index : Natural; + + -- Ada-fied list of all RMS keywords, translated from the + -- HP C Run-Time Library Reference Manual, Table REF-3: + -- RMS Valid Keywords and Values + + type RMS_Keys is + (Access_Callback, Allocation_Quantity, Block_Size, Context, + Default_Extension_Quantity, Default_File_Name_String, Error_Callback, + File_Processing_Options, Fixed_Header_Size, Global_Buffer_Count, + Multiblock_Count, Multibuffer_Count, Maximum_Record_Size, + Terminal_Input_Prompt, Record_Attributes, Record_Format, + Record_Processing_Options, Retrieval_Pointer_Count, Sharing_Options, + Timeout_IO_Value); + + begin + Index := Form'First + Klen - 1; + while Index < Form'Last loop + Index := Index + 1; + + -- Scan for the token signalling VMS RMS Keys ahead. Should + -- whitespace be eaten??? + + if Form (Index - Klen .. Index - 1) = VMS_RMS_Keys_Token then + + -- Allocate the VMS form string that will contain the cryptic + -- CRTL RMS strings and initialize it to all nulls. Since the + -- CRTL strings are always shorter than the Ada-fied strings, + -- it follows that an allocation of the original size will be + -- more than adequate. + VMS_Form := new String'(Form (Form'First .. Form'Last)); + VMS_Form.all := (others => ASCII.NUL); + + if Form (Index) = '=' then + Index := Index + 1; + if Form (Index) = '(' then + while Index < Form'Last loop + Index := Index + 1; + + -- Loop through the RMS Keys and dispatch. + + for Key in RMS_Keys loop + declare + KImage : String := RMS_Keys'Image (Key); + begin + Klen := KImage'Length; + To_Lower (KImage); + if Form (Index .. Index + Klen - 1) = KImage then + case Key is + + when Context => + Index := Form_RMS_Context_Key + (Form (Index + Klen .. Form'Last), + VMS_Form); + exit; + + when others => + raise Use_Error + with "unimplemented VMS RMS Form Key"; + end case; + end if; + end; + end loop; + + if Form (Index) = ')' then + + -- Done, erase the unneeded trailing comma and + -- return. + + for J in reverse VMS_Form'First .. VMS_Form'Last loop + if VMS_Form (J) = ',' then + VMS_Form (J) := ASCII.NUL; + return; + end if; + end loop; + + -- Shouldn't be possible to get here + raise Use_Error; + + elsif Form (Index) = ',' then + + -- Another key ahead, exit inner loop + null; + else + + -- Keyword value not terminated correctly + raise Use_Error with "malformed VMS RMS Form"; + end if; + end loop; + end if; + end if; + + -- Found the keyword, but not followed by correct syntax + raise Use_Error with "malformed VMS RMS Form"; + end if; + end loop; + end Form_VMS_RMS_Keys; + ------------- -- Is_Open -- ------------- @@ -868,6 +1070,17 @@ package body System.File_IO is Form_Boolean (Formstr, "text_translation", Default => True); end if; + -- Acquire settings of target specific form parameters on VMS. Only + -- Context is currently implemented, for forcing a byte stream mode + -- read. On non-VMS systems, the settings are ultimately ignored in + -- the implementation of __gnat_fopen. + + -- Should a warning be issued on non-VMS systems? That's not possible + -- without testing System.OpenVMS boolean which isn't present in most + -- non-VMS versions of package System. + + Form_VMS_RMS_Keys (Formstr, VMS_Formstr); + -- If we were given a stream (call from xxx.C_Streams.Open), then set -- the full name to the given one, and skip to end of processing. @@ -1030,7 +1243,19 @@ package body System.File_IO is -- since by the time of the delete, the current working directory -- may have changed and we do not want to delete a different file! - Stream := fopen (Namestr'Address, Fopstr'Address, Encoding); + if VMS_Formstr = null then + Stream := fopen (Namestr'Address, Fopstr'Address, Encoding, + Null_Address); + else + Stream := fopen (Namestr'Address, Fopstr'Address, Encoding, + VMS_Formstr.all'Address); + end if; + + -- No need to keep this around + + if VMS_Formstr /= null then + Free (VMS_Formstr); + end if; if Stream = NULL_Stream then @@ -1042,15 +1267,15 @@ package body System.File_IO is declare function Is_File_Not_Found_Error (Errno_Value : Integer) return Integer; - -- Non-zero when the given errno value indicates a non- - -- existing file. - pragma Import (C, Is_File_Not_Found_Error, "__gnat_is_file_not_found_error"); + -- Non-zero when the given errno value indicates a non- + -- existing file. - Errno : constant Integer := OS_Lib.Errno; + Errno : constant Integer := OS_Lib.Errno; Message : constant String := Errno_Message (Name, Errno); + begin if Is_File_Not_Found_Error (Errno) /= 0 then raise Name_Error with Message; @@ -1196,8 +1421,21 @@ package body System.File_IO is Fopen_Mode (Mode, File.Is_Text_File, False, File.Access_Method, Fopstr); - File.Stream := freopen - (File.Name.all'Address, Fopstr'Address, File.Stream, File.Encoding); + Form_VMS_RMS_Keys (File.Form.all, VMS_Formstr); + + if VMS_Formstr = null then + File.Stream := freopen + (File.Name.all'Address, Fopstr'Address, File.Stream, + File.Encoding, Null_Address); + else + File.Stream := freopen + (File.Name.all'Address, Fopstr'Address, File.Stream, + File.Encoding, VMS_Formstr.all'Address); + end if; + + if VMS_Formstr /= null then + Free (VMS_Formstr); + end if; if File.Stream = NULL_Stream then Close (File_Ptr); diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index a81597a5af6..d3ec497188d 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1311,6 +1311,7 @@ package body Sem is S_In_Spec_Expr : constant Boolean := In_Spec_Expression; S_Inside_A_Generic : constant Boolean := Inside_A_Generic; S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope; + S_Style_Check : constant Boolean := Style_Check; Generic_Main : constant Boolean := Nkind (Unit (Cunit (Main_Unit))) @@ -1318,6 +1319,10 @@ package body Sem is -- If the main unit is generic, every compiled unit, including its -- context, is compiled with expansion disabled. + Ext_Main_Source_Unit : constant Boolean := + In_Extended_Main_Source_Unit (Comp_Unit); + -- Determine if unit is in extended main source unit + Save_Config_Switches : Config_Switches_Type; -- Variable used to save values of config switches while we analyze the -- new unit, to be restored on exit for proper recursive behavior. @@ -1386,9 +1391,6 @@ package body Sem is -- Sequential_IO) as this would prevent pragma Extend_System from being -- taken into account, for example when Text_IO is renaming DEC.Text_IO. - -- Cleaner might be to do the kludge at the point of excluding the - -- pragma (do not exclude for renamings ???) - if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit), Renamings_Included => False) then @@ -1423,12 +1425,28 @@ package body Sem is -- For unit in main extended unit, we reset the configuration values -- for the non-partition-wide restrictions. For other units reset them. - if In_Extended_Main_Source_Unit (Comp_Unit) then + if Ext_Main_Source_Unit then Restore_Config_Cunit_Boolean_Restrictions; else Reset_Cunit_Boolean_Restrictions; end if; + -- Turn off style checks for unit that is not in the extended main + -- source unit. This improves processing efficiency for such units + -- (for which we don't want style checks anyway, and where they will + -- get suppressed), and is definitely needed to stop some style checks + -- from invading the run-time units (e.g. overriding checks). + + if not Ext_Main_Source_Unit then + Style_Check := False; + + -- If this is part of the extended main source unit, set style check + -- mode to match the style check mode of the main source unit itself. + + else + Style_Check := Style_Check_Main; + end if; + -- Only do analysis of unit that has not already been analyzed if not Analyzed (Comp_Unit) then @@ -1482,6 +1500,7 @@ package body Sem is In_Spec_Expression := S_In_Spec_Expr; Inside_A_Generic := S_Inside_A_Generic; Outer_Generic_Scope := S_Outer_Gen_Scope; + Style_Check := S_Style_Check; Restore_Opt_Config_Switches (Save_Config_Switches); diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 06232069702..f9da78add6d 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2457,14 +2457,6 @@ package body Sem_Ch10 is return; end if; - -- We reset ordinary style checking during the analysis of a with'ed - -- unit, but we do NOT reset GNAT special analysis mode (the latter - -- definitely *does* apply to with'ed units). - - if not GNAT_Mode then - Style_Check := False; - end if; - -- If the library unit is a predefined unit, and we are in high -- integrity mode, then temporarily reset Configurable_Run_Time_Mode -- for the analysis of the with'ed unit. This mode does not prevent diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 9ab79c77e64..baffbec965a 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -751,6 +751,7 @@ package body Switch.C is Identifier_Character_Set := 'n'; System_Extend_Unit := Empty; Warning_Mode := Treat_As_Error; + Style_Check_Main := True; -- Set Ada 2012 mode explicitly. We don't want to rely on the -- implicit setting here, since for example, we want @@ -1173,6 +1174,7 @@ package body Switch.C is when 'y' => Ptr := Ptr + 1; + Style_Check_Main := True; if Ptr > Max then Set_Default_Style_Check_Options;