forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

URGENT HELP
Goto page 1, 2  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit
View previous topic :: View next topic  
Author Message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Wed Apr 25, 2018 4:03 am    Post subject: URGENT HELP Reply with quote

Folks, Can you please compile this program ASAP? I have to stop using this compiler, or stop programming completely, this damn devils joke will kill me, now it crashes not only the code but the compiler even if i comment almost everything and i do not see the error. Just do
Code:
FTN95 aaa.f95
and it immediately crashes on or just after module. I commented the Caller part to try to find the bad place, removed subs but FTN95 still crashes. Code still has many errors but i even do not see the damn error report. Somewhere possible German, French or Russian ASCII symbol from the hell was somehow produced like a poison and the English compiler is almost dead

Code:
module All_subs_Bremms
  use clrwin
  parameter (idim=50)
  real*8 x(idim), y1(idim), y2(idim), y3(idim)

  character*320 chParForSimplePlot_f_E
  integer kPlot1, kPlot2, kPlot3
  integer k32bit, k64bit, kSave_f_E_to_File
  integer lxWin, lyWin, iRunning_El_f_E_Fit
  real*8  TextSizeSmplpl_r8, LineWidthSmplpl_r8
  integer iRunning_El_f_E_Fit
contains
end module

!.....................................................
!
!Program Caller
!use All_subs_Bremms
!integer, external:: Plot
!
!     lxWin = 800
!     lyWin = 600
!     TextSizeSmplpl_r8  = 3
!     LineWidthSmplpl_r8 = 2
!
!     chParForSimplePlot_f_E = '%pv%pl[x_axis="E [keV]",y_axis="f(E) (arb.un.)",title="Electron f(E) - blue,  Ion f(E) - black",&
!     &colour=blue, colour=black, colour=red, colour=#339900, colour=green, x_array, scale=log_linear, N_GRAPHS=6, Y_MIN=1.] %ff&'
!
!     x (:)   = 0
!     y1(:)   = 0
!     y2(:)   = 0
!     y3(:)   = 0
!
!     k_Plot1 = 0
!     k_Plot2 = 0
!     k_Plot3 = 0
!
!     k32bit  = 0
!     k64bit  = 1 
!
!   do i=1,  idim
!     X (i) = i
!     Y1(i) = sin(i/10.)
!     Y2(i) = sin(i/20.)
!     Y3(i) = sin(i/30.)
!   enddo
!
!i=winio@('%ww&')
!i=winio@('In 32bits - Old and New, in 64 only New PL%ff%rb[OldPL]%rb[NewPl]%ff&', k32bit, k64bit)
!i=winio@('%2`ga%ff%cn%^bt[Start]%es', k32bit, k64bit, Plot)
!
!end program


!................................................................


Last edited by DanRRight on Wed Apr 25, 2018 6:15 am; edited 9 times in total
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Wed Apr 25, 2018 4:05 am    Post subject: Reply with quote

Code:
!................................................................

  integer function Plot ()

   use All_subs_Bremms
   integer, external ::  cb_Plot
   character chLineWid*16

   do i=1,  idim
     X (i) = i
     Y1(i) = sin(i/10.)
     Y2(i) = sin(i/20.)
     Y3(i) = sin(i/30.)
   enddo

       i = winio@('%1`tl&', 32.d0)
        i=winio@('%ww%ca[Distribution Functions]&')

        i=winio@('%1.3ob[scored]&')   

        i=winio@(' Max energy [eV] for f(E)%ta%df%10rf %ff&', &
                  aStepIncrE0*MaxEnergyFor_f_E, MaxEnergyFor_f_E)

        i=winio@('%cb&')

         i=winio@('%^rb[Plot El. ]%ff&', kPlot1, cb_plot)
         i=winio@('%^rb[Plot Ion1]%ff&', kPlot2, cb_plot)
         i=winio@('%^rb[Plot Ion2]%ff&', kPlot3, cb_plot)
         i=winio@('%^rb[Save to File f_E dat]%ff&', kSave_f_E_to_File, cb_plot)

        i=winio@('%cb&')


         i=winio@('%80rs%ff&', chParForSimplePlot_f_E)


        TextSizeSmplpl  = TextSizeSmplpl_r8
   LineWidthSmplpl = LineWidthSmplpl_r8


!   if(k64bit.eq.1) CALL winop@("%pl[y_sigfigs=5]") 
        if(k64bit.eq.1) CALL winop@("%pl[native]")
        if(k64bit.eq.1) call winop@("%pl[framed]")

        i=winio@('%sf&')
        i=winio@('%ts&', TextSizeSmplpl_r8)
        i=winio@('%bf&')

!       if(k64bit.eq.1) CALL winop@("%pl[etched]")
        if(k64bit.eq.1) CALL winop@("%pl[margin=92]")
        if(k64bit.eq.1) CALL winop@("%pl[tick_len=8]")
   if(k64bit.eq.1) CALL winop@("%pl[axes_pen=3]")

   chLineWid='%pl[width= 3]'
   write(chLineWid(11:12),'(i2)') nint(LineWidthSmplpl)
        if(k64bit.eq.1) CALL winop@(chLineWid)

!..........
   do i=1,  idim
     X (i) = i
     Y1(i) = sin(i/10.)
     Y2(i) = sin(i/20.)
     Y3(i) = sin(i/30.)
   enddo

                                                       

         i=winio@(chParForSimplePlot_f_E, &
         lxWin, lyWin, nfEMax4, XfEplLog, YfEplLog, &
         TfESumplLog, TfE1_OnOffplLog, TfE2_OnOffplLog, Ei1fEplLog, Ei2fEplLog)


         i=winio@(' Text Size (0.1-1.0)%ta%df%8rf%ff&',  0.01d0, TextSizeSmplpl_r8)
         i=winio@(' Line width (1-10)%ta%df%8rf%ff&', 0.2d0, LineWidthSmplpl_r8)

      i=winio@('%cb&')

      i=winio@('%ff&')


         i=winio@('%ac[esc]&','exit')
         i=winio@('%ac[Alt+X]&','exit')
         i=winio@('%ff%cn%^bt[OK]&','exit')
         i=winio@('%lw',ilwww2)

10000  Plot =2
  end function Plot

!---------------------------------------------------------
  integer function cb_plot ()
     use All_subs_Bremms

   IF(iRunning_El_f_E_Fit.eq.1) goto 10000
      iRunning_El_f_E_Fit = 1

   do i=1,  idim
     X (i) = i
     Y1(i) = sin(i/10.)*(1e-30+kPlot1)
     Y2(i) = sin(i/20.)*(1e-30+kPlot2)
     Y3(i) = sin(i/30.)*(1e-30+kPlot3)
   enddo

     call simpleplot_redraw@


9999     iRunning_El_f_E_Fit = 0

10000  cb_plot = 2
  end function cb_plot
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Wed Apr 25, 2018 7:59 am    Post subject: Reply with quote

This code reveals a bug in FTN95 which will be fixed for the next release.

It can be avoided by providing an explicit type for IDIM.

Code:
  integer,parameter::idim=50
Back to top
View user's profile Send private message AIM Address
DietmarSiepmann



Joined: 03 Jun 2013
Posts: 279

PostPosted: Wed Apr 25, 2018 8:05 am    Post subject: Reply with quote

Dan,

compiling the complete code results in a runtime error producing error report
Code:

Runtime error from program:c:\win32app\silverfrost_8.30\ftn95\ftn95.exe
Access Violation
The instruction at address 00456e9a attempted to read from location 00000000

 0045606a process_module_attribute_bits(<ptr>struct─scoped_entity,<ref>enum─logical,<ref> [+0e30]
 004580f5 read_module_entity(enum─logical)#1D [+0bae]
 00459a8e process_binary_module(int,enum─logical)#1D [+02da]
 0045ace4 process_use_stmt(<ptr>char,<ref>int) [+026a]
 0040b2cd parse_declaration_statement(<ptr>char,int,int,<ref>int) [+2af5]
 0041315b handle_token(<ptr>char,int,int,int,int,<ref>int) [+0e04]
 004056b3 ProcessEntireLine(void) [+06cf]
 00406697 compile(<ptr>char) [+0165]

eax=03d4f144   ebx=00000000   ecx=0000000d
edx=0568d9bc   esi=00000000   edi=03d4f144
ebp=03d4f1a0   esp=03d4ca1c   IOPL=3
ds=002b   es=002b   fs=0053
gs=002b   cs=0023   ss=002b
flgs=00210206 [NC EP NZ SN DN NV]

 00456e9a  rep       
 00456e9b  movs     
 00456e9c  orb      [ebp-0x5b],0x4

on my machine. Compiling only the first page (using the module definition only) is ok.

Regards,
Dietmar
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Wed Apr 25, 2018 11:55 am    Post subject: Reply with quote

Dan,

I got a stack of errors compiling this code.
I used "ftn95 aaa.f95 /-imp"

first, I needed " integer, parameter :: idim=50"
(I have always thought your parameter statement was not supported by FTN95)

then
duplicate iRunning_El_f_E_Fit in module

then
[FTN95/Win32 Ver. 8.30.0 Copyright (c) Silverfrost Ltd 1993-2018]

PROCESSING MODULE [<ALL_SUBS_BREMMS> FTN95/Win32 v8.30.0]
NO ERRORS [<ALL_SUBS_BREMMS> FTN95 v8.30.0]
0084) i=winio@(' Max energy [eV] for f(E)%ta%df%10rf %ff&', &
0085) aStepIncrE0*MaxEnergyFor_f_E, MaxEnergyFor_f_E)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
0118) write(chLineWid(11:12),'(i2)') nint(LineWidthSmplpl)
*** Error 328: The first argument (A) to the intrinsic NINT must be of REAL
type, not INTEGER(KIND=3)
0131) i=winio@(chParForSimplePlot_f_E, &
0132) lxWin, lyWin, nfEMax4, XfEplLog, YfEplLog, &
0133) TfESumplLog, TfE1_OnOffplLog, TfE2_OnOffplLog, Ei1fEplLog, Ei2fEplLog)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
*** Error 140: WINIO@ cannot process REAL(KIND=1) arguments, only CHARACTER,
INTEGER(3) or REAL(2)
0149) 10000 Plot =2
WARNING - 21: Label 10000 is declared, but not used
9 ERRORS, 1 WARNING [<PLOT> FTN95 v8.30.0]
0169) 9999 iRunning_El_f_E_Fit = 0
WARNING - 21: Label 9999 is declared, but not used
NO ERRORS, 1 WARNING [<CB_PLOT> FTN95 v8.30.0]
*** Compilation failed

You should try "ftn95 aaa.f95 /imp"
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Wed Apr 25, 2018 3:04 pm    Post subject: Reply with quote

Damn, I have to blame myself that time ago I did not ask the question why this Parameter claim did not work. Instead, I fixed it and forgot. Today I got for that laziness the anger, yell and swearing level that no one with finishing school would survive to stay nearby my room. After a week of crashes of simple code, I decided to make a small reproducer. Can you imagine that at the end if the day I got even worse situation when I couldn't even compile?!! Thanks all.

Please report anything you find in your programs, do not delay, the smaller users base means everyone has actively participate in the product quality improvement. If you are not sure, then don't hesitate posting like a discussion. Anything we did not make perfect kicks us later in the back.
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Fri Apr 27, 2018 6:33 pm    Post subject: Reply with quote

Comment Deleted as duplicated by following one !

PS - why is the delete Comment option not there top right of comment box , I'm sure it used to be?
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "


Last edited by John-Silver on Sat Apr 28, 2018 4:44 pm; edited 1 time in total
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Fri Apr 27, 2018 6:33 pm    Post subject: Reply with quote

I tried out the problem on my machine.
More or less as reported above by John C.

A couple of comments though:

1. a 'micro bug' - when I got the error messsage window pop up before applying 'the fix' I clicked on the 'details' button and I noticed when comparing with JohnC's listing above that all the message was not there !!!! This part must have been done by he who fixed the forum posting limit LOL Wink.

2. I also noticed that going futher than the first screen there are endless numbers of pop ups with the diagnostics 4 or 5 lines at a time. Isn't it possible to print them all in one go into a scrolling window ? ????

3. OK onto the real business .... IMPLICIT NONE ! Forum readers immediatley split into one side or other of the seperated dead sea !

Having tried it the /imp compile option is an interesting one and could be useful.
I say could be because although it can pick out the iddities (like in this cas giving a human explanation of the critical error, it's:
a) also loaded with tons of stuff to wade through, even for a small program like this.
b) after a few errors ir prints 'too many errors' and stops reporting them - can this be overridden ? if not it should be made possible !

Here's the interesting bit ....
c) IMPLICIT definition doesn't correctly specify the types of winio@ parameters thn !!!! ... as demonstrated with the errors picked out in this example with /imp used.

So, this is surely a deficiency within FTN95 no ?
i.e. it should check , if implicit is used and flag them out automatically !
Now, where have I heard this before ??? :O)

Of course the 'FTN95 crew' will argue it's the user's responsability to check - well, yes and no imo .
It's always best imo to define everything yourself BUT Fortran 95 allows implicit definition and so Clearwin+ winio@, etc ... parameters , if defined implicitly should also be made 'fool-proof' and given the correct type(s) no ? ... or at least meaningful error messages !!!

I now leave the debate open to allcomer professional wrestlers .... ding-ding
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "


Last edited by John-Silver on Sat Apr 28, 2018 4:51 pm; edited 1 time in total
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Fri Apr 27, 2018 7:40 pm    Post subject: Reply with quote

Thanks, John,

The code above was not worth considering beyond the reason for the crash. You all found that there is a bug in FTN95 with "Parameter (idim=50)" settings like I used above while it goes OK using a bit different syntax "integer parameter:: idim=50" and I thank all for that.

But this also tells me about the unimaginable and totally unbelievable other side of the medal, truly the life story about human nature that

NO ONE REPORTS ANY BUGS!

This relates to everything in life, not just FTN95, literally everything. Negligible amount of people really care. And that the

FTN95 DEVELOPERS DO NOT USE THEIR OWN COMPILER FOR ANY JOB (teaching, consultancy, writing contract programs, comparing with other compilers, even code validation). Again the use is negligible, probably.

Tell me I'm wrong and I will ask: FTN95 is 20 years old and no one had parameter set this very common way?

This code intended to make smaller demo out of larger code crashing on simpleplot_update@ and was just the start for longer source text which never came even first cleaning due to FTN95 crash so it had uncountable not related bugs and typos. A bit cleaner but also still not the one I intended to do source text which revealed two other problems with FTN95 and Clearwin+ I also posted in other place for Paul and Robert to look.

http://forums.silverfrost.com/viewtopic.php?t=3791

I am still fighting to find what causes crash with simpleplot_update@ while all goes OK on other very similar places and on all my smaller demos.
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Sun Apr 29, 2018 1:11 pm    Post subject: Reply with quote

Dan, WINIO@ is the name of a privileged FTN95 intrinsic. The compiler knows this function, and ignores any type and interface declarations for WINIO@ in user code. Furthermore, the actual external name that is referenced is not WINIO@, but WINDOW_PRINTF@@ (for the calls that I saw; for instances where WINIO@ requires input, perhaps there is a similar WINDOW_SCANF@@ ?)

In fact, I don't think that it is possible to write a proper interface for it in Fortran. There has to be a perfect match in the %xx specifiers in the first argument and the types of the second, etc., arguments to WINIO@, as with the C printf() function.

Unfortunately, at present there is also a bug in the implementation of WINIO@ in 32-bit mode; see http://forums.silverfrost.com/posting.php?mode=quote&p=24788 . Fortunately, if your code does not contain many WINIO@calls, especially such calls inside DO loops, you may not even notice the bug and your code will probably work correctly.

Given the current assignments of functionality between the compiler and the FTN95 DLLs, allowing checking for undefined arguments to WINIO@ will probably have a negative effect on performance of user code, and there may be other reasons why checking is impossible for undefined arguments that are passed to WINIO@ in calls from code that was not compiled with /undef .
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Sun Apr 29, 2018 8:03 pm    Post subject: Reply with quote

Quote:
The compiler knows this function, and ignores any type and interface declarations for WINIO@ in user code.


which seems to be it's achiles heel maybe ?.

Quote:
allowing checking for undefined arguments to WINIO@ will probably have a negative effect on performance of user code,


surely this should not be an excuse for not implementing checking - a compile option could be set up which only affects the runtime of development code and which could be ignored 8not used) for final code compilation (like other debug options)

I hesitate to say that the lack of fundamental checking of variables to winio@ is a fundamental design fault because that would be unfair, and of course such implementation is labour intensive (a la '60+ occurrences would need checking' invoked by Paul in nother post, but it's the price to pay for having what is effectively an additional higher-level language-layer of winio@, etc... calls. Every extra level of 'cross-calling' inevitaby brings a computing (compile time ) penalty at some point. One hopes it will be at worst only linear but experience says it quickly evolves into polynomial proportions. Not anybody's fault just a fact of life.

A solution to the resources problem is one I threw into the melting pot a short while ago on another post - 'recruit' freebie help from FTN95's educatonal roots - so many students spending so much time in the union bar (been there, done it Wink ) when they could be interacting with industry (it's called gaining work experience).

Shouldn't approaches from companies, especialy smaller ones like Silverfrost be welcomed, nay actively encouraged, with open arms in that respect ?

Isn't that what the milk-snatcher said when she was on the rise (where was god with his divine intervention when you needed him most LOL) and shouldn't that be a key attainment goal of the much lauded and much bandied about phrase 'the Northern Powerhouse' crusdade, or would I be cynical in thinking that my region of the country (amongst others) is actually thought of and tagged as such by Westminster as the 'Northern Poorhouse' ?

But I digress, just get some of those idle students to help you out ... just supply them with one of those in-mode office prosecco-dispensing-machines that seem to be the newest 'recruitment fad' of late .... well ok, a crate of beer or two as an incentive. You'd be surprised at the increase in productivity it can achieve LOL.

Of course, %pl should take priority in their task list Wink :O) ! LOL
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Mon Apr 30, 2018 12:58 am    Post subject: Re: Reply with quote

DanRRight wrote:
You all found that there is a bug in FTN95 with "Parameter (idim=50)" settings like I used above while it goes OK using a bit different syntax "integer parameter:: idim=50" ...
Tell me I'm wrong and I will ask: FTN95 is 20 years old and no one had parameter set this very common way?

Dan, the compiler crash is seen only for the specific code that you posted and not with every declaration with the old F77-style PARAMETER (var1=cnst1, ...) declaration. I took the code for just the module All_subs_Bremms in your first post in this thread, removed the superfluous CONTAINS line, and put the remaining lines into a source file. Compiling it with no options gave
Code:
s:\FTN95\BW>ftn95 danm.f90
[FTN95/Win32 Ver. 8.30.0 Copyright (c) Silverfrost Ltd 1993-2018]
    PROCESSING MODULE  [<ALL_SUBS_BREMMS> FTN95/Win32 v8.30.0]
0011)   integer iRunning_El_f_E_Fit
WARNING - ALL_SUBS_BREMMS!IRUNNING_EL_F_E_FIT has been declared more than once with the same type (see line 9)
    NO ERRORS, 1 WARNING  [<ALL_SUBS_BREMMS> FTN95 v8.30.0]

and compiling the same source file with /imp gave
Code:
s:\FTN95\BW>ftn95 danm.f90 /imp
[FTN95/Win32 Ver. 8.30.0 Copyright (c) Silverfrost Ltd 1993-2018]
    PROCESSING MODULE  [<ALL_SUBS_BREMMS> FTN95/Win32 v8.30.0]
0011)   integer iRunning_El_f_E_Fit
WARNING - ALL_SUBS_BREMMS!IRUNNING_EL_F_E_FIT has been declared more than once with the same type (see line 9)
0003)   parameter (idim=50)
*** IDIM must appear in a type declaration because IMPLICIT NONE has been used
    1 ERROR, 1 WARNING  [<ALL_SUBS_BREMMS> FTN95 v8.30.0]
*** Compilation failed

As you can see, the compiler performed as expected when it was given code containing the F77 style PARAMETER declaration.


Last edited by mecej4 on Mon Apr 30, 2018 11:38 am; edited 1 time in total
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Mon Apr 30, 2018 4:25 am    Post subject: Re: Reply with quote

mecej4 wrote:
Dan, Fortunately, if your code does not contain many WINIO@calls, especially such calls inside DO loops, you may not even notice the bug and your code will probably work correctly.

Given the current assignments of functionality between the compiler and the FTN95 DLLs, allowing checking for undefined arguments to WINIO@ will probably have a negative effect on performance of user code, and there may be other reasons why checking is impossible for undefined arguments that are passed to WINIO@ in calls from code that was not compiled with /undef .


Mecej4,

Alas, the codes have a lot of winio@ calls, many thousands. But may be good is that i almost moved all of them 64bit. Hopefully with all the details from the users we will pesticide most annoying bugs. Also hope that Paul will be able to add for Clearwin+_ checking of input for for undefinied variables. There will be zero impact on performance for most of them. Sometimes probably there will be even positive impact (i had in the past posted here couple cases when i was forced to add the delay 0.01-0.1 seconds for GUI to work reliably. Seriously, LOG(-1.) or SQRT(-2.) get us error report even with /NOCHECK while Clearwin+ prefers to crash with access violation! This is huge design defect, i agree with John-S, totally unacceptable for CWP to be broadly used in future by fortraners.

mecej4 wrote:
Dan, the compiler crash is seen only for the specific code that you posted and not with every declaration with the old style PARAMETER (var1=cnst1, ...)

Interesting. I have other cases crashing, simple like 2x2. Was lazy to report this 10 years ago and damn thing resurfaced now. What this program, for example ( which is doing nothing just showing how SQRT(-negNumb) is reported ) produces in your computer, isn't it crashing too?

Code:
module A
parameter (idim=100)
real*8 AA(idim)
end module

program AAA
use A
AAAA=sin(4.)
AAAAA=sqrt(AAAA)
end


Last edited by DanRRight on Mon Apr 30, 2018 4:48 am; edited 1 time in total
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Mon Apr 30, 2018 4:46 am    Post subject: Reply with quote

When a computer program -- your program, the compiler or the OS kernel -- malfunctions or reports an error, that is not necessarily a crash. Ideally, programs should have no bugs, but we know what happens in real life. Finding a bug does not imply anything regarding poor design, etc. Often, when a compiler fails, it can be because of an error made by the compiler user that the compiler did not anticipate, and so the compiler is unprepared to deal with the error.

With a little help and understanding from us, plus good bug reports and a responsive compiler vendor such as Silverfrost, we can make steady progress.

Take the code that you just gave, for example. Inspection shows three things:

(i) look carefully at the Access Violation pop up that the compiler gave. Look at the traceback, and observe that the abort occurred in "process_module_attribute_bits". Look at the console and observe that the compiler reported "NO ERRORS" after it processed the module code. That is a hint that the compiler abort was caused by the main program, not the module.

(ii) the module is really not needed or used by the program, so we can remove the USE statement. Doing so (or commenting that line out) makes the compiler bug stay away.

(iii) take out the module part and put it into a separate file. The module gets compiled with no problems. Now compile the program part (after the module has been removed) with and without the USE statement. It is the irrelevant USE statement that causes the compiler to fail.

After seeing all this, do you still wish to attribute the compiler bug to the presence of a F77-style PARAMETER statement in an unrelated module?


Last edited by mecej4 on Mon Apr 30, 2018 11:39 am; edited 1 time in total
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Mon Apr 30, 2018 5:16 am    Post subject: Reply with quote

Mecej
Let's check that differently, double sht's possible. This code crashes

Code:
module A
parameter (idim=10)
real*4 AA(idim)
end module

program AAA
use A
AA(:)=-1
AAAAA=sqrt(AA(1))
end


this one has more relevant module crashes too
Code:
module A
parameter (idim=10)
real*4 AA(idim)
contains
  subroutine AAA
  AA(:)=-1
  end subroutine
end module

program AAA
use A
CALL AAA
AAAA=sqrt(AA(1))
end


while this one with removed line Parameter inside the module does not. What you will say now?

Code:
module A
!!!!! parameter (idim=10)
real*4 AA(10)
end module

program AAA
use A
AA(:)=-1
AAAAA=sqrt(AA(1))
end
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit All times are GMT + 1 Hour
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group